Private Function XorPassword(Bytes As Variant) As String
Dim XorBytes() As Variant
Dim strPassword As String
Dim intIndex As Integer
Dim CurrChar As String * 1
XorBytes = Array(&H86, &HFB, &HEC, &H37, &H5D, &H44, &H9C, &HFA, &HC6, &H5E, &H28, _
&HE6, &H13, &HB6, &H8A, &H60, &H54, &H94)
strPassword = vbNullString
intIndex = 0
Do
CurrChar = Chr$(Bytes(intIndex + &H42) Xor XorBytes(intIndex))
If Asc(CurrChar) = 0 Then Exit Do
strPassword = strPassword & CurrChar
intIndex = intIndex + 1
Loop Until intIndex = 17
XorPassword = strPassword
End Function
Private Function GetAccessPassword(strFilename As String) As String
Dim intFileNum As Integer
Dim Bytes(&H100) As Byte
intFileNum = FreeFile
Open strFilename For Binary As #intFileNum
Get #intFileNum, , Bytes
GetAccessPassword = XorPassword(Bytes)
Close #intFileNum
End Function
Private Sub cmdBrowse_Click()
On Error GoTo canceled
OpenDialog.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
OpenDialog.ShowOpen
txtFilename.Text = OpenDialog.FileName
Exit Sub
canceled:
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdGetPassword_Click()
Dim strFilename As String
strFilename = Trim$(txtFilename.Text)
If Len(strFilename) = 0 Then
MsgBox "You must select a filename !", vbOKOnly Or vbInformation
ElseIf Len(Dir(strFilename)) = 0 Then
MsgBox "The filename does not exist !", vbOKOnly Or vbInformation
Else
txtPassword.Text = GetAccessPassword(strFilename)
End If
End Sub
|