Source Code Untuk Membuka/Crack Password VBA Excell dan Word

editing @2020 ……..

….. Mohon maaf dikarenakan banyaknya permintaan dan tidak bisa terkirim, dengan berat hati kami hanya mengirim ke teman2 yang telah melakukan donasi untuk biaya pengiriman via paketan data, karena dengan situasi dan kondisi saat ini kami kesulitan untuk online dengan paketan yang terbatas. untuk donasi bisa email terlebih dahulu ke alamat email ini : indra0379@gmail.com … salam.

Dibawah ini source untuk membuka password VBAExcell, ini saya dapatkan dari pas saya browsing-browsing di internet nemukan source ini yang berguna bagi saya, saya mendapatkan source ini dari website : http://www.vbbego.com bagi yang belum jelas langsung aja buka websitenya langsung, source code untuk vb6.0 seperti dibawah ini :

buka 1 project dengan 1 form, 1 module, 1 commandbutton :

yang ini source di form :

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

yang ini source untuk module :

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

Kalo gak bisa lebih jelasnya langsung  ke website aja ya, source ini sudah saya coba dan hasilnya sungguh luar biasa ini bisa untuk membuka password vba excell. terima kasih saya ucapkan kepada yang sudah membuat source ini, makasih untuk http://www.vbbego.net ini sangat berarti buat saya. dan mohon maaf kalo source ini saya teruskan ke teman-teman yang lain OK. chaou…..