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.
;)Maybe somebody may have think that i was just spamming inCode: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
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]
