|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Banco de Dados)
|
|
 |
Título da Dica: Obter a senha de um banco de dados Access 2000
|
 |
|
|
|
Postada em 11/1/2005 por ghost_jlp
Adicione um módulo em seu projeto e coloque o código abaixo
Public Const LEN_PWD = &H14
Public Const LEN_PWD_CHAR = &H2
Public Const LEN_PWD_COMPILED = LEN_PWD * LEN_PWD_CHAR
Public Const LEN_DATETIME_COMPILED = &H8
Public Const OFFSET_PWD_INTERVAL = &H4
Public Const OFFSET_PWD_COMPILED = &H42
Public Const OFFSET_DATETIME_COMPILED = &H72
Public Const OFFSET_XOR_GET = OFFSET_PWD_COMPILED + LEN_PWD_COMPILED - OFFSET_PWD_INTERVAL
Public Const VAL_XOR_FIX = &H2A7DA8A8
Public Function GetAccessPwd(FileTexte As String) As String
On Error GoTo lblError
Dim NEW_XOR_VAL As Long, NEW_XOR_CHAR As Variant, i As Long, NewPassword As String, PART_CHAR As String
Dim PART_CHAR_HEX As String
NEW_XOR_VAL = GetValCompiled(Mid(FileTexte, OFFSET_XOR_GET + 1, 4)) Xor VAL_XOR_FIX
NEW_XOR_CHAR = Array(&H37EDE6BC, &HFA9D5967, &HE62943FC, &H608BAB29, &H367A896E, &HB1DE6FCF, &H4312E94D, &H33B0B2F5, &H5B787C0E, &H2A7DA8A8)
For i = 1 To LEN_PWD_COMPILED / OFFSET_PWD_INTERVAL
PART_CHAR = Mid(FileTexte, OFFSET_PWD_COMPILED + (i - 1) * OFFSET_PWD_INTERVAL + 1, 4)
PART_CHAR_HEX = AddChar(Hex((GetValCompiled(PART_CHAR) Xor NEW_XOR_VAL) Xor NEW_XOR_CHAR(i - 1)), 8)
NewPassword = Chr(InvHex(Mid(PART_CHAR_HEX, 1, 4))) & Chr(InvHex(Mid(PART_CHAR_HEX, 5, 4))) & NewPassword
Next i
GetAccessPwd = StrReverse(Replace(NewPassword, Chr(0), ""))
Exit Function
lblError:
GetAccessPwd = "Erro ao acessar o arquivo"
End Function
Public Function Replace(ByVal TheString As String, ByVal StringSearch As String, ByVal NewString As String) As String 'Remplace une chaine de charactère par une autre.
Dim RstString As String
Replace = TheString
If Len(StringSearch) <> 0 Or Len(TheString) <> 0 Then
While InStr(TheString, StringSearch)
If Len(RstString) > 0 Then
If Len(StringSearch) > 1 Then
If InStr(TheString, StringSearch) = 1 Then RstString = RstString & NewString Else RstString = RstString & Left(TheString, (InStr(TheString, StringSearch)) - 1) & NewString
Else
RstString = RstString & Left(TheString, (InStr(TheString, StringSearch)) - 1) & NewString
End If
Else
RstString = Left(TheString, (InStr(TheString, StringSearch)) - 1) & NewString
End If
If Len(StringSearch) > 1 Then TheString = Right(TheString, Len(TheString) - (InStr(TheString, StringSearch)) - (Len(StringSearch) - 1)) Else TheString = Right(TheString, Len(TheString) - (InStr(TheString, StringSearch)))
Wend
If Len(TheString) > 0 Then RstString = RstString & TheString
Replace = RstString
End If
End Function
Public Function GetValCompiled(Texte As String) As Long 'Permet de lire la valeur d'une donnée compilée.
Dim NewVal As String, NewTexte As String, i As Long
NewTexte = StrReverse(Texte)
For i = 1 To Len(NewTexte)
NewVal = NewVal & AddChar(Hex(Asc(Mid(NewTexte, i, 1))), 2)
Next i
GetValCompiled = InvHex(NewVal)
End Function
Public Function Ouvrir(FileName As String) As String 'Ouvre un fichier en mode binaire.
On Error GoTo Erro
Dim GetFree As Long
GetFree = FreeFile
Open FileName For Binary As GetFree
Ouvrir = String(LOF(GetFree), " ")
Get #GetFree, 1, Ouvrir
Close GetFree
Erro:
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical
End Function
Public Function AddChar(Val As String, TheLen As Long, Optional Char As String = "0") As String 'Permet d'ajouter un charactère à une chaine de charactère pour obtenir une certaine longueur.
AddChar = Right(String(TheLen, Char) & Val, TheLen)
End Function
Public Function InvHex(ValHex As String) As Long 'Transforme une valeur Hexadécimale en valeur Décimale.
InvHex = Val("&h" & ValHex & "&")
End Function
Para usar utilize um command button por exemplo:
Private Sub Command1_Click()
msgbox GetAccessPwd(Ouvrir("c:caminho_do_arquivo.mdb"))
End Sub
Ressalvas
1) O access 2000 permite senhas de até 20 caracteres porém o código acima descobre senhas de até 18 caracteres.
2) Este código não serve para descobrir senha em banco de dados access 97
fonte: http://www.vbfrance.com
até a próxima :D
|
|
|
|
|
