Recuperando Senha do Banco de Dados Access 2000

Visitas

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