Oi!

 Pessoal, hoje tentei executar um dos programas q tenho de testes e ocorreu um erro dizendo do caminho invalido. Dai tentei acessar o proprio banco de dados e nao estou conseguindo da  a seguinte mensagem:

" O bando de dados C:Teste/Estoque precisar ser reparado ou nao é um arquivo de bando de dados.

 Talves voce ou outro usuario tenham saido inesperadamente do microsoft acess enquanto aberto.

 Deseje reparar? "  Quando clico em Sim ele pede a senha , dai digito a senha e ele emite outra mensagem de Senha invalida, e ainda da outra mensagem - repete que precisa ser reparada..

 Tentei reparar e sempre emite senha invalida, mas verifiquei e a senha esta correta..

 Alguem pode me ajudar???

 Abraços

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

 

vlu//

Consegui reparar o bd, mas agora qdo o programa é executada sempre que abre um form q tem um data emite a seguinte mensagem: "Formato do banco de dados C:...nao é reconhecido".

 Alguem pode me ajudar por favor???

T+

vc está usando qual versão de Banco de dados?? Access 2000? 97?

fiz em 2000 e converti para 97.

 

Se o sistema foi desenvolvido p/access 2000 ele não irá reconhecer ser a base estiver em access 97 e vice e versa