Private Sub btnPass2000_Click()
    On Error GoTo errHandler
    Dim ch(40) As Byte
    Dim x As Integer, sec2, intChar As Integer, blnUse3 As Boolean
    If Trim(txtFileName) = "" Then Exit Sub
    'Used integers instead of hex  Easier to read
    sec2 = Array(0, 194, 117, 236, 55, 25, 202, 156, 250, 130, 208, 40, 230, _
      87, 56, 138, 96, 16, 26, 123, 54, 177, 252, 223, 177, 51, 122, 19, 67, _
      139, 33, 177, 51, 112, 239, 121, 91, 214, 59, 124, 42)
    'I found that some DB's use this scheme see below for the logic to _
    determine which is which
    sec3 = Array(0, 229, 117, 236, 55, 62, 202, 156, 250, 165, 208, 40, 230, _
    112, 56, 138, 96, 55, 26, 123, 54, 150, 252, 223, 177, 20, 122, 19, 67, _
    172, 33, 177, 51, 87, 239, 121, 91, 241, 59, 124, 42)
    txtPass.Text = ""
    blnUse3 = False
 
    Open txtFileName.Text For Binary Access Read As #1 Len = 40
    Get #1, &H42, ch
    Close #1
    'Check to see which key by running through first 6 letters of password
    'This is not foolproof by any means.
    For x = 1 To 6
      intChar = ch(x) Xor sec2(x)
         'This is kind of lame but it assumes that most passwords
         'are in this range of keyboard chars
      If ((intChar < 32) Or (intChar > 126)) And (intChar <> 0) Then
         blnUse3 = True 'Set a flag
      End If
    Next x
    'Allow force of key3.
    If chkUse3.Value = vbChecked Then
      blnUse3 = True
    End If
    'Now solve for password
    For x = 1 To 40
         If blnUse3 = True Then
            intChar = ch(x) Xor sec3(x)
         Else
            intChar = ch(x) Xor sec2(x)
         End If
         txtPass.Text = txtPass.Text & Chr(intChar)
    Next x
    Exit Sub
errHandler:
    MsgBox "ERROR occcured:" & vbCrLf & Err.Number & ":  " & Err.Description, _
      vbCritical, "ERROR"
    Exit Sub
End Sub
 
Private Sub btnPass97_Click()
On Error GoTo errHandler
    Dim ch(18) As Byte, x As Integer
    Dim sec
    If Trim(txtFileName) = "" Then Exit Sub
    'Used integers instead of hex  Easier to read
    sec = Array(0, 134, 251, 236, 55, 93, 68, 156, 250, 198, 94, 40, 230, 19, _
      182, 138, 96, 84)
    txtPass.Text = ""
    Open txtFileName.Text For Binary Access Read As #1 Len = 18
    Get #1, &H42, ch
    Close #1
    For x = 1 To 17
        txtPass.Text = txtPass.Text & Chr(ch(x) Xor sec(x))
    Next x
    Exit Sub
errHandler:
    MsgBox "ERROR occcured:" & vbCrLf & Err.Number & ":  " & Err.Description, _
      vbCritical, "ERROR"
    Exit Sub
 
End Sub
 
Private Sub btnOpen_Click()
On Error GoTo errHandler
    With CommonDialog1
       .CancelError = True 'Causes error on Cancel
       .Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*"
       .FilterIndex = 1
       .ShowOpen
       txtFileName.Text = .FileName
    End With
    Exit Sub
errHandler:
   txtFileName.Text = ""  'Ensure it is empty
   Exit Sub
End Sub