Remove excel vb password
New a excel and open Visual Basic edit window, then insert a module. Put below code in module.
===============Source Code==========================
Option Explicit
#If Win64 Then
Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As LongLong, Source As LongLong, ByVal Length As LongLong)
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongLong, _
ByVal dwSize As LongLong, ByVal flNewProtect As LongLong, lpflOldProtect As LongLong) As LongLong
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongLong
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongLong, _
ByVal lpProcName As String) As LongLong
Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongLong, _
ByVal pTemplateName As LongLong, ByVal hWndParent As LongLong, _
ByVal lpDialogFunc As LongLong, ByVal dwInitParam As LongLong) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongLong
Dim Flag As Boolean
#Else
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean
#End If
#If Win64 Then
Private Function GetPtr(ByVal Value As LongLong) As LongLong
#Else
Private Function GetPtr(ByVal Value As Long) As Long
#End If
'Get func pointer
GetPtr = Value
End Function
Public Sub RecoverBytes()
'If hooked then recover pre-API 6byte that alse is recover pre-func's fucntion
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
#If Win64 Then
Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As LongLong
Dim OriginProtect As LongLong
#Else
Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long
#End If
Hook = False
'VBE6.dll call DialogBoxParamA to show VB6INTL.dll resource of dialogbox 4070(that is password dialogbox)
'If DialogBoxParamA return true, then VBE will belived password correct, so we will hook DialogBoxParamA func
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
'Standand api hook 1: change memory attribute, make sure that will writeable
If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then
'Standand api hook 2: Judge whether hook, look out first byte if is &H68,
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) <> &H68 Then
'Standand api hook 3: Save pre-func's first 6bytes for recovery
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
'Get MyDialogBoxParam pointer with AddressOf
p = GetPtr(AddressOf MyDialogBoxParam)
'Standand api hook 4: Construct new API enter
HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3
'standand API hook 5: replace API first 6bytes by HookBytes cotent
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
'set hook done flag
Flag = True
Hook = True
End If
End If
End Function
#If Win64 Then
Private Function MyDialogBoxParam(ByVal hInstance As LongLong, _
ByVal pTemplateName As LongLong, ByVal hWndParent As LongLong, _
ByVal lpDialogFunc As LongLong, ByVal dwInitParam As LongLong) As Integer
#Else
Private Function MyDialogBoxParam(ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
#End If
If pTemplateName = 4070 Then
'someone call Dialogbox with 4070 then return 1,that make VBE believe the password is correct
MyDialogBoxParam = 1
Else
'some call Dialogbox without 4070, we call RecoverBytes to recover pre-func's fucntion, then go pre-func
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
'pre-func done, call hook again
Hook
End If
End Function
=================================================
Go to Sheet1, and put below code in Sheet1 code window.
=============== Source Code ==========================
Sub crack()If Hook Then
MsgBox "crack done"
End If
End Sub
Sub recover()
RecoverBytes
MsgBox "recover done"
End Sub
===================================================