Hello,
The code below is the complete code for revealing the Access97 password,
and the 3 first caracters of Access2000 (sorry for not putting all the
code but it repeats the filling of the array (just different values)

The question is:
Can this code be improved in any way, i mean don´t using so many controls?
(dtpicker,commondialog)

if so, please be kind to explain it to me.

Code:
Option Explicit
Dim MaxSize, NextChar, MyChar, SecretPos, TempPwd
Dim Diferencia
Dim Resto1
Dim Resto2
Dim Entero
Dim I As Integer
Dim secretXx(2) As Integer
Dim Secret97(13)
Dim NoSecret2K(19)
Dim Secret2K(15, 1)

Private Sub Command1_Click()
    Clipboard.SetText (Text2)
End Sub

Private Sub Command2_Click()
    Clipboard.SetText ("")
    Unload Me
End Sub

Private Sub Command3_Click()
    Inicio
End Sub

Private Sub Form_Load()
    Inicio
End Sub

Private Sub Inicio()
    Text1 = ""
    ComDiag1.ShowOpen
    Text1 = ComDiag1.Filename
    If Text1 <> "" Then
        Creada
        Text2 = AccessPassword(Text1)
        Command1.Enabled = False
        If Text2 <> "" Then
            Command1.Enabled = True
        End If
    End If
End Sub

Private Sub Creada()
    Dim fs, f, s, xx
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(Text1)
    If Format(f.DateCreated, "dd/MM/yyyy") >= DTPicker1.MinDate Then
        DTPicker1.Value = Format(f.DateCreated, "dd/MM/yyyy")
    Else
        MsgBox "La Fecha del Archivo es Anterior al 01/01/2000", vbInformation, "Fecha Inválida"
    End If
    Diferencia = DTPicker1.Value - DTPicker2.Value
    If Diferencia >= 0 Then
        Resto1 = Diferencia Mod 256
        Entero = Int(Resto1 / 16)
        Resto2 = Resto1 Mod 16
    End If
End Sub

Function AccessPassword(ByVal Filename As String) As String

secretXx(0) = 21
secretXx(1) = 59
secretXx(2) = 60

'Access 97
Secret97(0) = (&H86)
Secret97(1) = (&HFB)
Secret97(2) = (&HEC)
Secret97(3) = (&H37)
Secret97(4) = (&H5D)
Secret97(5) = (&H44)
Secret97(6) = (&H9C)
Secret97(7) = (&HFA)
Secret97(8) = (&HC6)
Secret97(9) = (&H5E)
Secret97(10) = (&H28)
Secret97(11) = (&HE6)
Secret97(12) = (&H13)
'Access 2000
NoSecret2K(0) = (&H4F)
NoSecret2K(1) = (&HEC)
NoSecret2K(2) = (&H94)
NoSecret2K(3) = (&HA)
NoSecret2K(4) = (&HA)
NoSecret2K(5) = (&HA)
NoSecret2K(6) = (&HA)
NoSecret2K(7) = (&HA)
NoSecret2K(8) = (&HA)
NoSecret2K(9) = (&HA)
NoSecret2K(10) = (&HA)
NoSecret2K(11) = (&HA)
NoSecret2K(12) = (&HA)
NoSecret2K(13) = (&HA)
NoSecret2K(14) = (&HA)
NoSecret2K(15) = (&HA)
NoSecret2K(16) = (&HA)
NoSecret2K(17) = (&HA)
NoSecret2K(18) = (&HA)
NoSecret2K(19) = (&HA)

SecretPos = 0
TempPwd = ""
Text3 = ""
Open Filename For Binary As #1
For I = 0 To 2
    Seek #1, secretXx(I)
    MyChar = Input(1, #1)
    Text3 = Text3 & Asc(MyChar) & "="
    TempPwd = TempPwd & Chr(Asc(MyChar))
Next
Text3 = Text3 & ">"
SecretPos = 0
MyChar = ""

    Label3(0).Visible = False
    Label3(1).Visible = False

    Label4(0).Visible = False
    Label4(1).Visible = False

If TempPwd = Chr(1) & Chr(228) & Chr(195) Then
    Label4(0).Visible = True
    Label4(1).Visible = True
    TempPwd = ""
    AccessPassword = Access2K
Else
    Label3(0).Visible = True
    Label3(1).Visible = True
    TempPwd = ""
    AccessPassword = Access97
End If
End Function

Function Access97()
    'Access 97
    For NextChar = 67 To 79 Step 1  ' Diez Caracteres
        Seek #1, NextChar
        MyChar = Input(1, #1)
        TempPwd = TempPwd & Chr(Asc(MyChar) Xor Secret97(SecretPos))
        Text3 = Text3 & Asc(MyChar) & " - "
        SecretPos = SecretPos + 1
    Next NextChar
    Close #1
    Access97 = TempPwd
End Function

Function Access2K()
    'Access 2000
    Dim HexChk As Boolean
    HexChk = True
    For NextChar = 67 To 105 Step 2 'Veinte Caracteres
        Seek #1, NextChar
        MyChar = Input(1, #1)
        If HexChk Then
            TempPwd = TempPwd & Chr(Asc(MyChar) Xor Const2K(SecretPos + 1)) 'Dependiente de Fecha
            Text3 = Text3 & Hex(Asc(MyChar) Xor 65) & "<- "
            HexChk = False
        Else
            TempPwd = TempPwd & Chr(Asc(MyChar) Xor NoSecret2K(SecretPos)) 'Constante
            Text3 = Text3 & Asc(MyChar) & " ->"
            HexChk = True
        End If
        SecretPos = SecretPos + 1   'Incrementa Puntero
    Next NextChar
    Close #1    ' Cierra el Archivo
    Access2K = TempPwd
End Function

Private Function Const2K(ByVal Posicion As Integer)
    If Posicion = 1 Then
        Secret2K(0, 0) = 6
        Secret2K(0, 1) = 0
        Secret2K(1, 0) = 7
        Secret2K(1, 1) = 1
        Secret2K(2, 0) = 4
        Secret2K(2, 1) = 2
        Secret2K(3, 0) = 5
        Secret2K(3, 1) = 3
        Secret2K(4, 0) = 2
        Secret2K(4, 1) = 4
        Secret2K(5, 0) = 3
        Secret2K(5, 1) = 5
        Secret2K(6, 0) = 0
        Secret2K(6, 1) = 6
        Secret2K(7, 0) = 1
        Secret2K(7, 1) = 7
        Secret2K(8, 0) = 14
        Secret2K(8, 1) = 8
        Secret2K(9, 0) = 15
        Secret2K(9, 1) = 9
        Secret2K(10, 0) = 12
        Secret2K(10, 1) = 10
        Secret2K(11, 0) = 13
        Secret2K(11, 1) = 11
        Secret2K(12, 0) = 10
        Secret2K(12, 1) = 12
        Secret2K(13, 0) = 11
        Secret2K(13, 1) = 13
        Secret2K(14, 0) = 8
        Secret2K(14, 1) = 4
        Secret2K(15, 0) = 9
        Secret2K(15, 1) = 5
    Else
        Secret2K(0, 0) = 13
        Secret2K(0, 1) = 13
        Secret2K(1, 0) = 12
        Secret2K(1, 1) = 12
        Secret2K(2, 0) = 15
        Secret2K(2, 1) = 15
        Secret2K(3, 0) = 14
        Secret2K(3, 1) = 14
        Secret2K(4, 0) = 9
        Secret2K(4, 1) = 9
        Secret2K(5, 0) = 8
        Secret2K(5, 1) = 8
        Secret2K(6, 0) = 11
        Secret2K(6, 1) = 11
        Secret2K(7, 0) = 10
        Secret2K(7, 1) = 10
        Secret2K(8, 0) = 5
        Secret2K(8, 1) = 5
        Secret2K(9, 0) = 4
        Secret2K(9, 1) = 4
        Secret2K(10, 0) = 7
        Secret2K(10, 1) = 7
        Secret2K(11, 0) = 6
        Secret2K(11, 1) = 6
        Secret2K(12, 0) = 1
        Secret2K(12, 1) = 1
        Secret2K(13, 0) = 0
        Secret2K(13, 1) = 0
        Secret2K(14, 0) = 3
        Secret2K(14, 1) = 3
        Secret2K(15, 0) = 2
        Secret2K(15, 1) = 2
    End If
    Const2K = Secret2K(Resto2, 0) + Secret2K(Entero, 1) * 16
End Function
Maybe somebody may have think that i was just spamming in
my previous posts, sorry if my posts led you to jump to
conclusions but i have so little experience in posting, and
sure have post in the wrong way...

Saludos...

[email protected]