***************************************************************************
'
' Visual Basic Source Code
' Situs mengenai seputar pemograman menggunakan visual basic.
' http://www.geocities.com/vb_bego
'
' Kirim pertanyaan anda ke:
'
' vbhelp_us@ yahoo.com
' mail42me@ telkom.net
' VanJava@ telkom.net
'
' Author: CyberBoy - BEGO admin
' Update terakhir, Maret - 2004
' � http://groups.yahoo.com/group/vb_bego
'
' NB: Anda Boleh mengedit source code ini, tanpa menghilangkan
' nama pembuat asli
'***************************************************************************
' VIVA PROGRAMMER INDONESIA
'
Option Explicit
Sub GetMs97(Filename As String)
'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
'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 listbox(lstpass)
Dim inLen As Integer
inLen = InStr(1, TempPwd, Chr(0))
lstPass.AddItem "Nama File: " & Filename
lstPass.AddItem "Ukuran : " & FileLen(Filename) & " bytes"
lstPass.AddItem "Panjang password: " & IIf(inLen = 0, 20, inLen - 1)
lstPass.AddItem "---------------------"
lstPass.AddItem TempPwd
End Sub
' EOF For access 97 password
'Nah sekarang kita coba untuk access 2000/xp
Sub GetMs2000XP(Filename As String)
'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
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 GetMs97 Filename: Exit Sub
'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 pada listpass
lstPass.AddItem "Nama File: " & Filename
lstPass.AddItem "Ukuran : " & FileLen(Filename) & " bytes"
lstPass.AddItem "Panjang password: " & IIf(inLen = 0, 20, inLen)
lstPass.AddItem "---------------------"
'Nah disini kita cari tau passwordnya
'Kita gunakan looping sampai dengan 255 kali
'ini dilakukan karena kita akan membadingkan
'sampai dengan karakter pertama sampai karakter terakhir(255)
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 ke lstpass
If InStr(1, Pwd, String(20 - inLen, Chr(0))) Then
If InStr(1, Pwd, String(20, Chr(0))) Then
lstPass.List(2) = "nggak ada passwordnya"
Else
lstPass.AddItem Pwd
End If
ElseIf InStr(1, Pwd, Chr(0)) = 0 Then
lstPass.AddItem Pwd
End If
Pwd = ""
Next I
End Sub
'Untuk tahap terakhir kita tulis code pada cmdExec
Private Sub cmdExec_Click()
With CD
.CancelError = True
On Error GoTo X
.Filter = "Ms. Access 97/2000/XP|*.mdb"
.ShowOpen
lstPass.Clear
GetMs2000XP .Filename
Exit Sub
X:
End With
End Sub
Private Sub Form_Load()
lstPass.AddItem "Jebol Password Ms.Access 97/2000/XP"
lstPass.AddItem "Copyright 2004 by CyberBoy - BEGO"
lstPass.AddItem "Update terakhir, April 2004"
lstPass.AddItem ""
lstPass.AddItem "* Open Source *"
lstPass.AddItem ""
lstPass.AddItem "Email: [EMAIL PROTECTED]"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.WindowState = vbMinimized
End
End Sub
Private Sub Label2_Click()
On Error Resume Next
Shell "explorer mailto:[EMAIL PROTECTED]", 1
End Sub
Untuk keluar dari millis ini, kirim email kosong ke:
[EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/programmer-vb/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
