USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página