[AccessD] Lost/Forgotten Password

Hi Gonzalez

> Gustav, I cant seem to find that Archive

OK, here goes - but remember, this is not for Access security (mdw
files) only simple database protection of Access 97 files.
>From A2000 (Jet 4.0) it is not that easy to handle.

(The old list mentioned is the one hosted by MT Group).

---

Recently we had to deal with some password protected Access 97 files and
found a message on this from the old list.

I've brushed it up slightly much because it contained a bug and because I
found out that a file password can be 20 characters long when set from code
but only 14 when set manually!

Anyway, here's the simple code to read the password from an Access 97 file -
also to warn you not to rely too much on this kind of protection (beware of
line breaks):

Public Sub smsAcc97PwdRead(ByVal vstrMdbPath As String)

'  Purpose:    Read MS Access 97 database level password
'  Written by: Shamil Salakhetdinov
'  e-mail:     shamil at marta.darts.spb.ru
'
'  Parameters:
'              vstrMdbPath - full path for MS Access 97 database
'
'
'  Credits:
'  www.rootshell.com/archive-j457nxiqi3gq59dv/199902/all-access.c.html
'
'  Modified:   2001-06-20. Cactus Data ApS.
'  Reason:     Password length was limited to 13 characters
'              Now reads a password with the maximum length of 20 characters.
'
'              String manipulation simplified.
'              Rudimentary check of file type as Jet file added.

  On Error GoTo smsAccPwdRead_Err

  Const cintAcc97JetOffset  As Integer = &H5
  Const cintAcc97PwdOffset  As Integer = &H43
  Const cintAcc97PwdLength  As Integer = 20
  ' Only up to cintAcc97PwdLenMan characters
  ' can be entered manually when changing password.
  Const cintAcc97PwdLenMan  As Integer = 14
  Const cstrJetFileTypeID   As String * 15 = "Standard Jet DB"
  Dim strJetBuf             As String * 15
  Dim strPwdClear           As String
  Dim strPwdBuf             As String * cintAcc97PwdLength
  Dim strPwd                As String
  Dim strMsgTxt             As String
  Dim strMsgTit             As String
  Dim intMsgMod             As Integer
  Dim bytChr                As Byte
  Dim intLen                As Integer
  Dim intFn                 As Integer
  Dim intI                  As Integer

  strPwdClear = Chr(&H86) & Chr(&HFB) & Chr(&HEC) & Chr(&H37) & _
                Chr(&H5D) & Chr(&H44) & Chr(&H9C) & Chr(&HFA) & _
                Chr(&HC6) & Chr(&H5E) & Chr(&H28) & Chr(&HE6) & _
                Chr(&H13) & Chr(&HB6) & Chr(&H8A) & Chr(&H60) & _
                Chr(&H54) & Chr(&H94) & Chr(&H7B) & Chr(&H36)

  strMsgTit = "Access 97 Jet File Password detection"
  strMsgTxt = "File '" & vstrMdbPath & "'" & vbCrLf

  intFn = FreeFile
  Open vstrMdbPath For Binary Access Read As #intFn
  Get #intFn, cintAcc97JetOffset, strJetBuf
  Get #intFn, cintAcc97PwdOffset, strPwdBuf
  Close intFn

  If Not StrComp(cstrJetFileTypeID, strJetBuf, vbBinaryCompare) = 0 Then
    ' Not a Jet file.
    strMsgTxt = strMsgTxt & "can not be identified as a Jet file."
    intMsgMod = vbExclamation + vbOKOnly
  Else
    For intI = 1 To cintAcc97PwdLength
      bytChr = Asc(Mid(strPwdBuf, intI, 1)) Xor Asc(Mid(strPwdClear,
intI, 1))
      Mid(strPwdBuf, intI, 1) = Chr(bytChr)
      If bytChr = 0 Then
        strPwd = Left(strPwdBuf, intI - 1)
        ' Stop loop.
        intI = cintAcc97PwdLength
      ElseIf intI = cintAcc97PwdLength Then
        strPwd = strPwdBuf
      End If
      Debug.Print Asc(strPwdBuf), strPwdBuf
    Next intI

    intLen = Len(strPwd)
    If intLen = 0 Then
      ' Password is empty.
      strMsgTxt = strMsgTxt & "is not password protected."
    Else
      strMsgTxt = strMsgTxt & "is protected by password:" & vbCrLf & _
                  "'" & strPwd & "'." & vbCrLf & vbCrLf & _
                  "Length of password is " & intLen & " character" &
Left("s", Abs(intLen > 1)) & "."
      If intLen > cintAcc97PwdLenMan Then
        strMsgTxt = strMsgTxt & vbCrLf & "This password can not be altered
manually!"
      End If
    End If
    intMsgMod = vbInformation + vbOKOnly
  End If

  MsgBox strMsgTxt, intMsgMod, strMsgTit

smsAccPwdRead_Exit:
  Exit Sub

smsAccPwdRead_Err:
  MsgBox "smsAccPwdRead: Err = " & Err & " - " & Err.Description
  Resume smsAccPwdRead_Exit

End Sub

---

Beware of line breaks.

/gustav