Script crack Passw MS access

Option Explicit
'by Eko cahyono (mail : eko_matrix)
Function GetMs97(Filename As String) As String ' Filename=alamt pathnya
'di procedure ini kita akan mencoba mengetahui password untuk
'ms.access 97 terlebih dahulu

'kita buat variable array sebanyak 20 dengan tipe byte.
'kenapa harus 20? Ini disebabkan panjang maximal password
'access adalah 20.

Dim data(0 To 19) As Byte, Pwd As String
Dim hasil As String
'Sekarang kita buka dan ambil data dari file yang akan di crack
'passwordnya.
Open Filename For Binary As #1
'Kita ambil data mulai dari posisi 67.
'kenapa harus pd posisi 67? Ini dikarenakan password yang disimpan
'oleh ms.access ada pada posisi tersebut
Get #1, 67, data
Close #1

Dim MaxSize, I As Integer, TempPwd
Dim EncDec As String, nKey
'untuk enskripsi dibawah ini, saya tidak bisa menjelaskannya.
'Karena terlalu panjang utk dijelaskan. Enskripsi ini hasil penelitian saya
'jadi anda tinggal pake aja OK!

'Panjang keseluruhan enskripsi ini tentunya sama dengan panjang max password (20).
'Kemudian kita split ke variable nKey.
EncDec = "86 FB EC 37 5D 44 9C FA C6 5E 28 E6 13 B6 8A 60 54 94 7B 36"
nKey = Split(EncDec, " ")


Dim spos As Integer
'Nah sekarang kita gunakan metode/fungsi XOR untuk mendapatkan password aslinya
'Nilai yang ada pada variable data, dibandingkan dengan nilai enskripsinya.
For I = 0 To 19
TempPwd = TempPwd & Chr(data(I) Xor ("&H" & nKey(spos)))
'var ini digunakan untuk mengetahui panjang password yang ada pd file yang dicrack.
spos = spos + 1
Next I


'hasilnya kita cetak ke Hasil
Dim inLen As Integer
inLen = InStr(1, TempPwd, Chr(0))
hasil = "Nama File: " & Filename & vbCrLf & _
"Ukuran : " & FileLen(Filename) & " bytes" & vbCrLf & _
"Panjang password: " & IIf(inLen = 0, 20, inLen - 1) & vbCrLf & _
"---------------------" & vbCrLf & _
TempPwd
GetMs97 = hasil
End Function

'Nah sekarang kita coba untuk access 2000/xp
Function GetMs2000XP(Filename As String) As String ' Filename=alamt pathnya
'kita buat variable array sebanyak 40 dengan tipe byte.
'kenapa harus 40? Ini disebabkan panjang maximal password
'access adalah 20, kemudian dikalikan 2 maka hasilnya 40.

Dim data(39) As Byte, cek As Byte, hasil As String
Open Filename For Binary As #1
'Kita ambil data mulai dari posisi 67.
'kenapa harus pd posisi 67? Ini dikarenakan password yang disimpan
'oleh ms.access ada pada posisi tersebut
Get #1, 67, data
Get #1, 151, cek
Close #1

'Sebelum melanjutkan mecrack 2000, kita periksa dahulu versi dari file tersebut
'jika versinya 97 maka kita panggil prosedur GetMs97 dan keluar dari rutin 2000
If cek = 0 Then
GetMs2000XP = GetMs97(Filename)
Exit Function
End If
'Kita buat var2 pendukung
Dim EncDec As String
Dim I As Integer
Dim H As Integer, nKey
Dim nHex As String
Dim Pwd As String

'untuk enskripsi dibawah ini, saya tidak bisa menjelaskannya.
'Karena terlalu panjang utk dijelaskan. Enskripsi ini hasil penelitian saya
'jadi anda tinggal pake aja OK!

'Tentunya enskripsi berikut berbeda dengan enskripsi untuk msa97
EncDec = "00 EC DB 9C 40 28 95 8A D2 7B 73 DF F1 13 49 B1 B2 79 14 7C"
nKey = Split(EncDec, " ")

'Kita cari tau panjang passwordnya, dengan metode XOR
Dim inLen As Integer
For H = 0 To UBound(nKey)
If H Mod 2 <> 0 Then
If (data(H * 2) Xor ("&H" & nKey(H))) = 0 Then
inLen = H
Exit For
End If
End If
Next H

'Hasil pencariannya kita cetak Hasil
hasil = "Nama File: " & Filename & vbCrLf & _
"Ukuran : " & FileLen(Filename) & " bytes" & vbCrLf & _
"Panjang password: " & IIf(inLen = 0, 20, inLen) & vbCrLf & _
"---------------------" & vbCrLf

'Nah disini kita cari tau passwordnya
'Kita gunakan looping sampai dengan 255 kali
'ini dilakukan karena kita akan membadingkan
'mulai karakter pertama sampai karakter terakhir(255)
'Kelemahan proses ini ialah, belum bisa menampilkan dengan tepat
'password yang panjangnya sampai 20 karakter
'jika passwordnya >= 20 maka kesuluruhan kemungkinan akan
'ditampilkan.

For I = 0 To 255
'looping kedua berfungsi untuk membandingkan nilai asli dari file
'dengan nilai enskripsi
For H = 0 To UBound(nKey)
If H Mod 2 = 0 Then
'membandingkan nilai
nHex = Hex((("&H" & nKey(H)) Xor I))
Else
nHex = nKey(H)
End If
'membandingkan nilai
Pwd = Pwd & Chr((data(H * 2) Xor ("&H" & nHex)))
Next H
'Cetak hasil enskripsi yang didapat HASIL
If InStr(1, Pwd, String(20 - inLen, Chr(0))) Then
If InStr(1, Pwd, String(20, Chr(0))) Then
hasil = hasil & "nggak ada passwordnya" & vbCrLf
Else
hasil = hasil & Pwd & vbCrLf
End If
ElseIf InStr(1, Pwd, Chr(0)) = 0 Then
hasil = hasil & Pwd & vbCrLf
End If
Pwd = ""
Next I
GetMs2000XP = hasil

End Function