RECUPERER LE MOT DE PASSE D'UNE DB ACCESS(POUR 97 ET 2000)

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