Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Private Const PAGE_EXECUTE_READWRITE = &H40
- Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
- (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
- Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
- ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
- Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
- Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
- ByVal lpProcName As String) As LongPtr
- Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
- ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
- ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
- Dim HookBytes(0 To 5) As Byte
- Dim OriginBytes(0 To 5) As Byte
- Dim pFunc As LongPtr
- Dim Flag As Boolean
- Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
- GetPtr = Value
- End Function
- Public Sub RecoverBytes()
- If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
- End Sub
- Public Function Hook() As Boolean
- Dim TmpBytes(0 To 5) As Byte
- Dim p As LongPtr
- Dim OriginProtect As LongPtr
- Hook = False
- pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
- If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
- MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
- If TmpBytes(0) <> &H68 Then
- MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
- p = GetPtr(AddressOf MyDialogBoxParam)
- HookBytes(0) = &H68
- MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
- HookBytes(5) = &HC3
- MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
- Flag = True
- Hook = True
- End If
- End If
- End Function
- Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
- ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
- ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
- If pTemplateName = 4070 Then
- MyDialogBoxParam = 1
- Else
- RecoverBytes
- MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
- hWndParent, lpDialogFunc, dwInitParam)
- Hook
- End If
- End Function
- Sub unprotected()
- If Hook Then
- MsgBox "VBA Project is unprotected!", vbInformation, "*****"
- End If
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement