Soyez le premier à donner votre avis sur cette source.
Vue 13 692 fois - Téléchargée 1 583 fois
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
10 juil. 2007 à 14:52
Pourriez-vous m'indiquer la méthode pour solutionner ce problème ?
Merci
10 juil. 2007 à 14:29
ce n'est pas du VBA mais du VB6 ... cela crée un vrai fichier exe et non un fichier doc, xls ou mdb .. ;)
BàT,
Icem@n
10 juil. 2007 à 14:09
Merci par avance
5 janv. 2005 à 11:03
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4045&lngWId=1
BàV,
Icem@n
20 déc. 2004 à 15:46
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.