Solve Word Password Problem 1

[PBAPaul]

I have a Word document that is password protected and I have forgotten the password! I know that the password is a combination of a couple of words and a 4 digit number.

I have looked at various shareware password crackers but all of them will only crack a couple of characters without spending a lot of money to register - and purely for this one document.

I have a list of 6 words (eg "John", "Fred" etc)and 2 numbers (eg 1234 or 4321) that I am sure are the possible components of the password.

Can anyone suggest a macro to systematically test the possible password combinations? Remembering my maths, I think that there are about 40,000 combinations of these 8 components. I don't fancy trying this manually!

Any help will be greatly appreciated!

 

[Loomah]

Hi
Intrigued by this one for a pure programming point of view but time ain't on my side so I found this link from a google search. Haven't looked too closely at it but it may be possible to combine this into a routine

http://www.planet-source-code.com/xq/ASP/txtCodeId.12732/lngWId.1/qx/vb/scripts/ShowCode.htm

Hope it does help.

;-) If a man says something and there are no women there to hear him, is he still wrong?

 

[rmikesmith]

PBAPaul,

Try the following procedure. Insert it into a standard code module in a new Word document. I wrote this specific to your situation so it should not be used as a general purpose routine. Inside the inner For..Next loop, I have duplicated some code to handle word first/ number last and vice versa. If you know for sure the password will be one or the other, you can remove the opposite coding, which will speed things up somewhat.

Sub CrackWordPW()
Dim wdDoc As Document
Dim PW As String
Dim Words(1 To 6) As String
Dim Nums(1 To 2) As String
Dim i As Integer
Dim j As Integer
Dim Found As Boolean


  Words(1) = "fred"
  Words(2) = "john"
  Words(3) = "mike"
  Words(4) = "ted"
  Words(5) = "bill"
  Words(6) = "james"
  
  Nums(1) = "1234"
  Nums(2) = "4321"
 
  On Error Resume Next
   
  Found = False
  For i = 1 To UBound(Words)
    For j = 1 To UBound(Nums)
      PW = Nums(j) & Words(i)
      Set wdDoc = Documents.Open(Filename:="Your path and filename here", PasswordDocument:=PW)
      If Err.Number = 0 Then
        MsgBox "Password = " & PW
        Found = True
      Else
        Err.Clear
      End If
      If Found Then Exit For
      
      PW = Words(i) & Nums(j)
      Set wdDoc = Documents.Open(Filename:="Your path and filename here", PasswordDocument:=PW)
      If Err.Number = 0 Then
        MsgBox "Password = " & PW
        Found = True
      Else
        Err.Clear
      End If
      If Found Then Exit For
        
    Next j
    If Found Then Exit For
  Next i

End Sub[code]


Notes:  You will need to substitute your filename and its associated path in the Open method.  Change the names to use as possible PW fragments, as appropriate.  Keep in mind, passwords are case sensitive.


Regards,
Mike

 

[PBAPaul]

Mike

You are a star to write some specific code for me.

I have run the code in Word 2000 but when the line

Set wdDoc = Documents.Open(Filename ........

runs, the password protect dialogue box for my file appears without any password and the program halts.

Any ideas?

Paul

 

[rmikesmith]

Paul,

I am also running this on Word 2000, without a problem. I was able to duplicate the behavior you described when the password string (PW) is an empty string. Try single-stepping through the code and look at the value of PW just before the line(s)

Set wdDoc = Documents.Open(Filename:= ...

The value should not be ""


Let me know what you find.

Mike

 

[PBAPaul]

Mike

This is weird!

I stepped through and PW is a string not "", but the dialogue still appears.

I selected Cancel and the program then ran and I was able to open the document as a read-only and re-create it as necessary.

Very many thanks! You are a star, so have a star!!

Paul