Option Explicit
Function xGetAccessPwd(ByVal FileName As String, intTable As Integer) As String
Dim intFileID As Integer
Dim intLenPass As Integer
Dim strMyChar As String
Dim strTempPwd As String
Dim strTempPwdCrypt As String
Dim bytSecretPos As Byte
Dim bytNextChar As Byte
Dim alngSecret(40) As Long
Select Case intTable
Case 0 ' access 97
alngSecret(0) = (&H86)
alngSecret(1) = (&HFB)
alngSecret(2) = (&HEC)
alngSecret(3) = (&H37)
alngSecret(4) = (&H5D)
alngSecret(5) = (&H44)
alngSecret(6) = (&H9C)
alngSecret(7) = (&HFA)
alngSecret(8) = (&HC6)
alngSecret(9) = (&H5E)
alngSecret(10) = (&H28)
alngSecret(11) = (&HE6)
alngSecret(12) = (&H13)
intLenPass = 12
Case 1 ' access 2000
alngSecret(0) = &HF5
alngSecret(1) = &HA
alngSecret(2) = &HEC
alngSecret(3) = &H56
alngSecret(4) = &H2E
alngSecret(5) = &HB5
alngSecret(6) = &H9C
alngSecret(7) = &H9B
alngSecret(8) = &HB5
alngSecret(9) = &HAF
alngSecret(10) = &H28
alngSecret(11) = &H87
alngSecret(12) = &H60
alngSecret(13) = &H47
alngSecret(14) = &H8A
alngSecret(15) = &H1
alngSecret(16) = &H27
alngSecret(17) = &H65
alngSecret(18) = &H7B
alngSecret(19) = &H57
alngSecret(20) = &H86
alngSecret(21) = &H83
alngSecret(22) = &HDF
alngSecret(23) = &HD0
alngSecret(24) = &H4
alngSecret(25) = &H5
alngSecret(26) = &H13
alngSecret(27) = &H22
alngSecret(28) = &HBC
alngSecret(29) = &H5E
alngSecret(30) = &HB1
alngSecret(31) = &H52
alngSecret(32) = &H47
alngSecret(33) = &H90
alngSecret(34) = &H79
alngSecret(35) = &H3A
alngSecret(36) = &HE1
alngSecret(37) = &H44
alngSecret(38) = &H7C
alngSecret(39) = &H4B
alngSecret(40) = &HE6
intLenPass = 40
End Select
bytSecretPos = 0
intFileID = FreeFile
Open FileName For Binary Access Read As #intFileID ' Open file for input.
For bytNextChar = 67 To 67 + intLenPass Step 1 ' Read in Encrypted Password
Seek #intFileID, bytNextChar ' Set position.
If EOF(intFileID) Then Exit For
strMyChar = Input(1, #intFileID) ' Read character.
strTempPwdCrypt = strTempPwdCrypt & strMyChar
' 1 caractère sur deux (seulement les Impaires)
If ((bytSecretPos And 1) Xor 1) Or IIf(intTable = 1, 0, 1) Then
strTempPwd = strTempPwd & Chr(Asc(strMyChar) Xor alngSecret(bytSecretPos)) 'Decrypt using Xor
End If
' regenere une table de decryptages
Text2.Text = Text2.Text & "alngSecret(" & bytNextChar - 67 & ") = &H" & Hex(Asc(strMyChar) Xor Asc("a")) & vbCrLf
bytSecretPos = bytSecretPos + 1 ' Increment pointer
Next
Close #intFileID ' Close file.
xGetAccessPwd = "Crypted : '" & strTempPwdCrypt & "' Decrypted : '" & strTempPwd & "'"
End Function
Private Sub cmdFile_Click()
cdgOpen.FileName = Text1.Text
cdgOpen.ShowOpen
Text1.Text = cdgOpen.FileName
End Sub
Private Sub Command1_Click()
Text2.Text = ""
MsgBox xGetAccessPwd(Text1.Text, IIf(optAccess97, 0, 1))
End Sub