revision du codes de Mr X
les parametres :
FileName : Le nom et l'emplacement de la base de donnée ("c:\trucmachin\hahapws.mdb")
intTable : la version de Access :
si Access 97 = 0
si Access 2000 = 1
il y a un problèmes sous Access 2000 il faut parfois reconstruire une table de decryption ??? Je n'ai hélas pas le temps de me pencher sur ce problèmes mais avec la nouvelle source il est possible de le reconstruire.
Source / Exemple :
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
Conclusion :
J'espère que se ne comporte plus de bug !!! :-)
en espèrent que M$ dans une prochaine version sécuriseras pour de vrais les base de données ....
Trop de problème avec Access 2000 allez voir ;-) :
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4045&lngWId=1
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.