Setelah sekian lama file ini ga ketemu (Mengapa aku posting ni tulisan karena lebih dari 2 bulan yang lalu aku buat VBA di excell n aku protect dengan password tapi aku lupa tu password hehe maklum pelupa), 1 minggu lalu aku ketemukan akan tetapi akan pindah di hardisk yang salah alias aku pindah di hardisk yang kena badsector jadi ya hilang lagi deh..... Setelah sekian lama aku diamkan tu hardisk sampai 1 minggu maka berhasil juga aku buka tu hardisk, hehe akhirnya aku buatkan juga gimana cara crack atau merubah password pada Microsoft Word maupun Excell yang didalamnya ada VBA yang di password.
Ni Tutorial aku dapatkan pada site www.vb-bego.net pada tahun 2006 yang dibuat oleh Anti Hacker.
Silahkan anda ikuti berikut ini:
Untuk mencoba source ini jalan apa nggak, coba bikin satu dokumen word atau excel, kemudian tekan ALT+F11 (maksudnya biar masuk ke VBA editorya) nah kalo udah berada pada VBA Editor, coba tambahkan beberapa component object. spt: module, form atau class.
Selanjutnya coba kamu proteksi VBA tersebut dengan cara klik kanan pada Project Explorer, kemudian pilih ...Properties...kemudian pilih TAB Protection.
Coba masukan password apa aja untuk mencobanya. kemudian save.
nah sekarang kita tinggal buat programnya.....hm..m...m.mmm..spt biasa tinggal Copy Paste nih source..., ok deh broo selamat mencoba.
Siapkan aja Form1 dan Command1 kemudian Copy Pastekan source berikut
Option Explicit
'// Header Password Untuk VBA
Const vbbego72 = "E9EB458A628A62759E8B62EFEB0B9567D2F09" & _
"604067445E7DBDA0C1565BA2023778FEFF9"
Const vbbego74 = "C2C06E8D52AA52AAAD5653AAE9253D286E4EE" & _
"E66E86F219911B87D7162FD74EEF579FEB513"
Const vbbego76 = "ADAF0155017E1E7E1E81E27F1E1BAF57D1DB8" & _
"E045A28FA28492BA70640C9B1EEEC57ABBBD325"
Const vbbegoxx = "5654FA3F0641585E585EA7A2595EDCE369B3D" & _
"FBAB6E0DBB94699F7682AD4B8EF5510B4E293F62A"
Private Sub Command1_Click()
Dim hFile As String
Dim inFile As Long, nLoop As Long
Dim Header As String
Dim State As Boolean
'// Header Key VBA Password
Header = Chr(&HD) & Chr(&HA) & Chr(&H44) & Chr(&H50) & _
Chr(&H42) & Chr(&H3D) & Chr(&H22)
'// Buka File Excel & Word
hFile = GetFile(Hwnd)
If Trim(hFile) <> "" Then
Dim isiDok As String * 1000
inFile = FileLen(hFile)
'// Lakukan pembackupan dokumen sebelum melakukan perubahan
Dim FileAsli As String
FileAsli = Dir(hFile & ".bak", vbNormal)
If FileAsli = "" Then
FileCopy hFile, hFile & ".bak"
End If
'// Baca Tulis Ke File
Open hFile For Binary Access Read Write As #1
'// Lakukan Pengulangan Menurut Ukuran File tsb
For nLoop = 1 To inFile Step 1000
'// Ambil Data Sebanyak 1000 Karakter
Get #1, nLoop, isiDok
DoEvents
Dim Pos1 As Long, pos2 As Long, pos3 As Long
'// Periksa Header Key Password
Pos1 = Instr(1, isiDok, Header, vbBinaryCompare)
If Pos1 Then
pos2 = nLoop + Pos1 + Len(Header) - 2
'// Ambil data pada pointer setelah Header Key
Get #1, pos2, isiDok
'// Periksa Isi data yg didapat, apakah terdapat End Key?
Pos1 = Instr(1, isiDok, Chr(&HD) & Chr(&HA), vbBinaryCompare)
If Pos1 Then
'// Hitung panjang password yang terdapat pada file
pos3 = Len(Replace(Mid(isiDok, 1, Pos1 - 1), Chr(34), ""))
If pos3 Then
Select Case pos3
Case 72
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego72
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case 74
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego74
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case 76
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego76
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case Else
'// Rubah dengan password baru
'Put #1, pos2 + 1, vbbegoxx
MsgBox "Password: komunitasvbbego", 64, "www.vbbego.com"
End Select
State = True
Exit For
End If '// Pos3
End If '// Pos1->2
End If '// Pos1->1
isiDok = ""
Next nLoop
Close #1
If State = False Then MsgBox "Password Tidak Ditemukan", _
16, "www.vbbego.com"
End If
End Sub
Setelah tu kamu tambahi Module1 kemudian tuliskan code berikut
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Function GetFile(Hwnd As Long) As String
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = Hwnd
OFName.hInstance = App.hInstance
OFName.lpstrFilter = "Ms Ofice97/XP/2003(*.doc;*.xls)" _
+ Chr$(0) + "*.doc;*.xls" + Chr$(0) _
+ "Kabeh File (*.*)" + Chr$(0) + "*.*" + Chr$(0)
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = "C:\"
OFName.lpstrTitle = "Open File - vbBego Team 2000"
OFName.flags = 0
If GetOpenFileName(OFName) Then
GetFile = Left(OFName.lpstrFile, _
InStr(1, OFName.lpstrFile, Chr(0)) - 1)
Else
GetFile = ""
End If
End Function
Setelah selesaikan tinggal di jalankan deh dengan menekan tombol F5. Klik Aja command1 kememudian cari dokumen yang ada VBA terpassword (jangan lupa ditutup dulu ya dokumennya)
Bagi yang susah mencopy pastekan tu source code silahkan ambil aja source codenya langsung yang aku tulis. klik disini
source : s0dikin.blogspot.com
