Rem ------------------------------------------------------------------------------------------------------------
Rem Access Database Password Recovery (ADPR)
Rem Recovers the passwords of most .mdb files
Rem © Copyright Craig Phillips, All rights reserved 2008-2009
Rem
Rem This program is free software: you can redistribute it and/or modify it under the terms of the GNU
Rem General Public License version 3 as published by the Free Software Foundation.
Rem
Rem This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
Rem even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Rem General Public License for more details.
Rem http://www.gnu.org/licenses/
Rem ------------------------------------------------------------------------------------------------------------
Rem Please do not use this code for any malicious activity
Rem I will not accept responsibility for any criminal act
Rem This code is purely for forgotten password recovery
Option Explicit
Rem http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=72736&lngWId=1
Private Sub cmdBrowse_Click()
cd.Filter = "Microsoft Access Files (*.mdb)|*.mdb|All Files (*.*)|*.*"
cd.DialogTitle = App.FileDescription
cd.ShowOpen ' Show open dialog
If Not Len(cd.FileName) = 0 Then
txtFile.Text = cd.FileName ' Put the filename into the textbox
Call GetPassword ' Get the password
End If
End Sub
Private Sub cmdClose_Click()
End ' End the program
End Sub
Private Function GetPassword()
On Error Resume Next
Dim Access2000Decode As Variant ' Decode Array (Access 2000)
Dim Access9597Decode As Variant ' Decode Array (Access 95/97)
Dim fFile As Integer ' File Number
Dim bCnt As Integer ' Loop Count
Dim ret95wd(17) As Byte ' Return 95/97 Password (max 18 chars)
Dim retXPwd(17) As Integer ' Return File Password (max 18 chars)
Dim wkCode As Integer ' Working Code
Dim mgCode As Integer ' Magic Code
'Define the Access 95/97 decode array
Access9597Decode = Array(&H86, &HFB, &HEC, &H37, &H5D, &H44, &H9C, &HFA, &HC6, _
&H5E, &H28, &HE6, &H13, &HB6, &H8A, &H60, &H54, &H94)
'Define the Access 2000 decode array
Access2000Decode = Array(&H6ABA, &H37EC, &HD561, &HFA9C, &HCFFA, _
&HE628, &H272F, &H608A, &H568, &H367B, _
&HE3C9, &HB1DF, &H654B, &H4313, &H3EF3, _
&H33B1, &HF008, &H5B79, &H24AE, &H2A7C)
If Len(txtFile.Text) > 0 Then ' If theres text in the file
fFile = FreeFile ' Free File Channel
Open txtFile.Text For Binary As #fFile ' Open the file
Get #fFile, 67, retXPwd ' Get Encoded Access 2000+ Password
Get #fFile, 67, ret95wd ' Get Encoded Access 95/97 Password
Get #fFile, 103, mgCode ' Get Magic code
Close #fFile
mgCode = mgCode Xor Access2000Decode(18) ' Xor magic code
txt9597Password.Text = vbNullString ' Clear the 95/97 Password textbox
txt2000Password.Text = vbNullString ' Clear the 2000+ textbox
For bCnt = 0 To 17
' Decode Access 95/97 Password
wkCode = ret95wd(bCnt) Xor Access9597Decode(bCnt)
txt9597Password.Text = txt9597Password.Text & Chr(wkCode)
' Decode Access 2000+ Password
wkCode = retXPwd(bCnt) Xor Access2000Decode(bCnt)
If wkCode < 256 Then ' Normal ASCII Code
txt2000Password.Text = txt2000Password.Text & Chr(wkCode)
Else ' Un-normal; XOR with Magic Code
txt2000Password.Text = txt2000Password.Text & Chr(wkCode Xor mgCode)
End If
Next bCnt
Else
txt2000Password.Text = "No file Selected" ' No file
End If
Exit Function
ErrHand:
MsgBox "Error with opening file", vbCritical, App.Title
End Function
Private Sub Command1_Click()
Me.ad.Filter = " Text Files (*.txt)|*.txt"
ad.ShowSave
On Error Resume Next
Open ad.FileName For Output As #1
On Error Resume Next
Print #1, "|Database Location : "; txtFile.Text + " | Access 95/97 Password : " + txt9597Password.Text + " | Access 2000+ Password : " + txt2000Password.Text; "|"
Close #1
End Sub
Private Sub mnuAbout_Click()
frmMain.Show
End Sub
Private Sub MNUexit_Click()
End
End Sub
Private Sub MnuLoad_Click()
cmdBrowse = True
End Sub
Private Sub MnuSave_Click()
Command1 = True
End Sub
