Já aconteceu comigo e provavelmente com você que está lendo. Incluir uma senha em um banco de dados Access 2000 e depois não recordar. Por isso, e por didática, resolvi postar o código em Visual Basic 6.0.
Veja Também Recuperando Senha do Banco de Dados Access 97
Vou considerar um Form com uma caixa de texto onde será colocado o caminho completo da base de dados. Um Botão que executará a quebra da senha e um rótulo que mostrará a senha.
No evento on_Click do botão, incluiremos o código.
Private Sub Command1_Click()
Label1.Caption = DescobreSenha2000(Text1.Text)
End Sub
Crie um módulo e inclua o código abaixo.
'Tamanho máximo da senha compila, onde cada caracter da senha
'estará representado pelo seu repectivo código ASC em hexadecimal
Const LEN_PWD_COMPILED = 20 * 2
Const OFFSET_PWD_INTERVAL = 4
Const OFFSET_PWD_COMPILED = 66
'Posição no arquivo onde começa a senha
Const OFFSET_XOR_GET = OFFSET_PWD_COMPILED + LEN_PWD_COMPILED - OFFSET_PWD_INTERVAL
'Valor padrão usado na conversão da senha
Const VAL_XOR_FIX = &H2A7DA8A8
Public Function DescobreSenha2000(ByVal FileName As String) As String
On Error GoTo Erro
Dim New_Xor_Val As Long
Dim New_Xor_Char As Variant
Dim i As Long
Dim NewPassword As String
Dim Part_Char As String
Dim Part_Char_Hex As String
Dim texto As String
Dim arq As Long
'Abrindo o arquivo é pegando os (OFFSET_XOR_GET + 5) primeiros bytes, pois é onde se encontrará a senha
arq = FreeFile
Open FileName For Binary As arq
texto = String(OFFSET_XOR_GET + 1 + OFFSET_PWD_INTERVAL, " ")
Get #arq, 1, texto
Close arq
New_Xor_Val = CompileVal(Mid(texto, OFFSET_XOR_GET + 1, OFFSET_PWD_INTERVAL)) Xor VAL_XOR_FIX
'Array padrão usado para decodificar a senha
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(texto, OFFSET_PWD_COMPILED + (i - 1) * OFFSET_PWD_INTERVAL + 1, OFFSET_PWD_INTERVAL)
Part_Char_Hex = AlnRight(Hex((CompileVal(Part_Char) Xor New_Xor_Val) Xor New_Xor_Char(i - 1)), 2 * OFFSET_PWD_INTERVAL)
NewPassword = Chr(HexToLng(Mid(Part_Char_Hex, 1, 4))) & Chr(HexToLng(Mid(Part_Char_Hex, 5, 4))) & NewPassword
Next
DescobreSenha2000 = StrReverse(Replace(NewPassword, Chr(0), ""))
Exit Function
Erro:
MsgBox "Erro: " & Err.Number & " - " & Err.Description
DescobreSenha2000 = "Erro na descoberta da senha"
End Function
'Compila o texto passado de acordo com a regra utilizada
'na "criptografia" da senha
Private Function CompileVal(Text As String) As Long
Dim Val As String
Dim TextRev As String
Dim i As Long
TextRev = StrReverse(Text)
For i = 1 To Len(TextRev)
Val = Val & AlnRight(Hex(Asc(Mid(TextRev, i, 1))), 2)
Next i
CompileVal = HexToLng(Val)
End Function
'Alinha a esquerda
Private Function AlnRight(Val As String, LenEnd As Long, Optional Char As String = "0") As String
AlnRight = String(LenEnd - Len(Val), Char) & Val
End Function
'Converte um número Hexadecimal em Inteiro Longo
Private Function HexToLng(ValHex As String) As Long
HexToLng = Val("&h" & ValHex & "&")
End Function
