下次自动登录
现在的位置:
API Hook 的应用——绕过 VBA 密码保护
网络转载，非原创
这是一段从网络收集的代码, 代码运用 API Hook 来绕过 VBA 的密码保护机制，在 VBE 中可以直接查看加密的 VBA 工程而不需要密码验证。网络转载，非原创，感谢作者提供的强大代码。注意：本代码不能用于 64 位 Office, 有时间我会把它修改一下，使其可以用于 64 位 Office。
VBA 免密查看.zip
具体代码如下：
'***************************************************************************
'* MODULE NAME: Protected VBA project Picklock(PVP)
'* AUTHOR & DATE: tt.t
'* 23 April 2007
'* E-Mail: ttui(ＡＴ)163.com, sohu邮箱垃圾邮件太多已经不用了
'* Usage: 运行FrmHookMain窗口,点补丁,然后双击工程窗口中有密码保护的模块
'* 应该能够直接打开了:)
'* DESCRIPTION: 在写中文字符串转换为拼音函数(HzToPy)过程中,第一次发现VBA功能的强大.
'* 于是这次尝试将其他语言中比较好写的API HOOK移植成VBA代码,
'* 正好顺便把VBA密码保护去掉,喜欢加密码的朋友不要生气啊:)
'* 总的来说VBA的写法和其他语言区别不大,但VBA毕竟不太方便,代码必须放在标准模块中.
'* 再有就是对指针的支持实在有限,于是最后选择了一种写起来最简单的API hook方法,
'* 就是所谓的陷阱法.如果你不太清楚什么是API HOOK,请求助于google.
'* Theory： 这里就不说API hook的方法了,都是传统方法没什么可说的,这里只
'* 简单说下VBA模块密码破解.其实这些我也不是很了解,毕竟知道加密过程
'* 用处不大,这个问题上我比较关心结果:)
'* 判断有密码以及提示输入密码都是VBE6.dll干得好事.如果有密码,
'* VBE6.dll会调用DialogBoxParamA显示VB6INTL.dll资源中的第4070号
'* 对话框(就是那个输入密码的窗口),若DialogBoxParamA返回值非0,
'* 则VBE会认为密码正确,然后乖乖展开加密模块的资源.很显然其中存在很大
'* 漏洞,就像给日记本加上了锁,但里面全是活页,我们不需要打开锁,只要从侧面
'* 取出活页就可以了.这个从侧面取活页的过程就是hook住DialogBoxParamA函数,
'* 若程序调用DialogBoxParamA装入4070号对话框,我们就直接返回1,让
'* VBE以为密码正确.
'* PS: PVP是在一个叫Advanced VBA Password Recovery (AVPR)的软件启发下
'* 作出来的,AVPR提供了一个VBA Backdoor功能就是跳过密码直接查看工程资源.
'* 它的原理和PVP一样,但用了通用性比较差的方法,适用系统比较有限,而PVP的方法
'* 理论上适用于所有采用第4070号对话框录入密码的Office系统.
'* 经测试PVP适用于Office , 2007,其他版本尚未测试,但估计依然有效.
'* 在2000和XP系统上测试通过,但条件限制没有在Vista系统上测试,听说Vista有些机制
'* 可能影响API hook,暂时没机会测试就先这样吧~
'* *64位操作系统下面的API hook代码肯定运行出错,就不要测试了
'***************************************************************************
Option Explicit
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
Private Function GetPtr(ByVal Value As Long) As Long
'获得函数的地址
GetPtr = Value
End Function
Public Sub RecoverBytes()
'若已经hook,则恢复原API开头的6字节,也就是恢复原来函数的功能
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long
Hook = False
'VBE6.dll 调用 DialogBoxParamA 显示 VB6INTL.dll 资源中的第 4070 号对话框(就是输入密码的窗口)
'若 DialogBoxParamA 返回值非 0,则 VBE 会认为密码正确,所以我们要 hook DialogBoxParamA 函数
pFunc = GetProcAddress(GetModuleHandleA(&user32.dll&), &DialogBoxParamA&)
'标准 api hook 过程之一: 修改内存属性,使其可写
If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) && 0 Then
'标准api hook过程之二: 判断是否已经hook,看看API的第一个字节是否为&H68,
'若是则说明已经Hook
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) && &H68 Then
'标准 api hook 过程之三: 保存原函数开头字节,这里是6个字节,以备后面恢复
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
'用 AddressOf 获取 MyDialogBoxParam 的地址
'因为语法不允许写成p = AddressOf MyDialogBoxParam,这里我们写一个函数
'GetPtr,作用仅仅是返回 AddressOf MyDialogBoxParam 的值,从而实现将
'MyDialogBoxParam 的地址付给p的目的
p = GetPtr(AddressOf MyDialogBoxParam)
'标准api hook过程之四: 组装API入口的新代码
'HookBytes 组成如下汇编
'push MyDialogBoxParam的地址
'作用是跳转到MyDialogBoxParam函数
HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3
'标准api hook过程之五: 用HookBytes的内容改写API前6个字节
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
'设置hook成功标志
Flag = True
Hook = True
End Function
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
If pTemplateName = 4070 Then
'有程序调用DialogBoxParamA装入4070号对话框,这里我们直接返回1,让
'VBE以为密码正确了
MyDialogBoxParam = 1
'有程序调用DialogBoxParamA,但装入的不是4070号对话框,这里我们调用
'RecoverBytes函数恢复原来函数的功能,在进行原来的函数
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
'原来的函数执行完毕,再次hook
End Function
【上篇】【下篇】
您可能还会对这些文章感兴趣！
您必须才能发表留言！急 MFC 如何屏蔽/解除 整个键盘鼠标消息
[问题点数：40分，结帖人debiaomanchui]
本版专家分：0
结帖率 100%
CSDN今日推荐
本版专家分：5910
本版专家分：3429
本版专家分：203
本版专家分：203
本版专家分：2817
本版专家分：163
本版专家分：0
本版专家分：485
本版专家分：0
本版专家分：22971
2011年7月 C/C++大版内专家分月排行榜第一
2011年8月 C/C++大版内专家分月排行榜第二
本版专家分：0
本版专家分：391
本版专家分：0
本版专家分：1345
本版专家分：0
本版专家分：0
本版专家分：2817
本版专家分：10552
本版专家分：0
本版专家分：14864
2012年3月 VC/MFC大版内专家分月排行榜第三2012年1月 VC/MFC大版内专家分月排行榜第三
本版专家分：558
本版专家分：14864
2012年3月 VC/MFC大版内专家分月排行榜第三2012年1月 VC/MFC大版内专家分月排行榜第三
匿名用户不能发表回复！|
其他相关推荐使用WinAPI函数，输入进程名，获得进程ID
[问题点数：20分，结帖人jackxu1982]
本版专家分：10
结帖率 96.55%
CSDN今日推荐
本版专家分：53973
2012年1月 荣获微软MVP称号2011年1月 荣获微软MVP称号
2007年9月 VB大版内专家分月排行榜第二
2008年3月 VB大版内专家分月排行榜第三2007年8月 VB大版内专家分月排行榜第三
本版专家分：17555
2006年7月 总版技术专家分月排行榜第二
2006年7月 Windows专区大版内专家分月排行榜第一2006年7月 VB大版内专家分月排行榜第一
2009年6月 VB大版内专家分月排行榜第二
本版专家分：10
本版专家分：14147
本版专家分：10
本版专家分：75834
2013年8月 VB大版内专家分月排行榜第一2013年3月 VB大版内专家分月排行榜第一2012年10月 VB大版内专家分月排行榜第一2012年9月 VB大版内专家分月排行榜第一2012年8月 VB大版内专家分月排行榜第一2012年7月 VB大版内专家分月排行榜第一2012年6月 VB大版内专家分月排行榜第一2012年5月 VB大版内专家分月排行榜第一2012年4月 VB大版内专家分月排行榜第一2012年3月 VB大版内专家分月排行榜第一2012年2月 VB大版内专家分月排行榜第一2012年1月 VB大版内专家分月排行榜第一2011年12月 VB大版内专家分月排行榜第一2011年11月 VB大版内专家分月排行榜第一2011年10月 VB大版内专家分月排行榜第一2011年9月 VB大版内专家分月排行榜第一2011年8月 VB大版内专家分月排行榜第一2011年7月 VB大版内专家分月排行榜第一
2011年1月 VB大版内专家分月排行榜第二2010年10月 VB大版内专家分月排行榜第二
2013年1月 VB大版内专家分月排行榜第三2012年12月 VB大版内专家分月排行榜第三2011年6月 VB大版内专家分月排行榜第三2011年2月 VB大版内专家分月排行榜第三2010年12月 VB大版内专家分月排行榜第三2010年11月 VB大版内专家分月排行榜第三2009年7月 VB大版内专家分月排行榜第三
本版专家分：17555
2006年7月 总版技术专家分月排行榜第二
2006年7月 Windows专区大版内专家分月排行榜第一2006年7月 VB大版内专家分月排行榜第一
2009年6月 VB大版内专家分月排行榜第二
本版专家分：10
本版专家分：10
本版专家分：17555
2006年7月 总版技术专家分月排行榜第二
2006年7月 Windows专区大版内专家分月排行榜第一2006年7月 VB大版内专家分月排行榜第一
2009年6月 VB大版内专家分月排行榜第二
本版专家分：14147
本版专家分：10
本版专家分：10
本版专家分：14147
本版专家分：14147
本版专家分：17555
2006年7月 总版技术专家分月排行榜第二
2006年7月 Windows专区大版内专家分月排行榜第一2006年7月 VB大版内专家分月排行榜第一
2009年6月 VB大版内专家分月排行榜第二
本版专家分：14147
本版专家分：17555
2006年7月 总版技术专家分月排行榜第二
2006年7月 Windows专区大版内专家分月排行榜第一2006年7月 VB大版内专家分月排行榜第一
2009年6月 VB大版内专家分月排行榜第二
匿名用户不能发表回复！|
其他相关推荐Excel中响应键盘事件(VBA)
我的图书馆
Excel中响应键盘事件(VBA)
Excel中响应键盘事件(VBA)
作为一名Excel的的"V粉"，你应该对Workbook、Worksheet的事件并不陌生，Excel为我们提供了一系列的事件方便我们编程。但需要注意的是，一些底层的事件响应Excel并未提供给我们，比如MouseMove、Keypress等等，那么就需要我们自行拓展了。说道Window消息的捕获及处理，大家首先想到的应该是Hook也就是我们常说的"钩子"，但在中使用钩子不是很稳定，容易导致Excel的意外崩溃。
在此之前我开发过响应鼠标滚轮滚动事件的Excel插件，但既然我们选择了一种语言进行Excel的二次开发，我们就没必要再加入的元素，既然选择了Vba我们就需要在Vba上下工夫。
既然我们放弃了Hook的方式，那还有其他的办法可以解决吗？下面的代码是我的Google搜到的一个老外的解决办法，代码如下：
Option Explicit
Private Type POINTAPI
&&&&x As Long
&&&&y As Long
Private Type MSG
&&&&hwnd As Long
&&&&Message As Long
&&&&wParam As Long
&&&&lParam As Long
&&&&time As Long
&&&&pt As POINTAPI
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
&&&&(ByRef lpMsg As MSG, ByVal hwnd As Long, _
&&&&&ByVal wMsgFilterMin As Long, _
&&&&&ByVal wMsgFilterMax As Long, _
&&&&&ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" _
&&&&(ByRef lpMsg As MSG) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
&&&&(ByVal hwnd As Long, _
&&&&&ByVal wMsg As Long, _
&&&&&ByVal wParam As Long, _
&&&&&lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
&&&&(ByVal lpClassName As String, _
&&&&&ByVal lpWindowName As String) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE& As Long = &H1
Private Const WM_CHAR&&& As Long = &H102
Private bExitLoop As Boolean
Sub TrackKeyPressInit()
&&&&Dim msgMessage As MSG
&&&&Dim bCancel As Boolean
&&&&Dim iKeyCode As Integer
&&&&Dim lXLhwnd As Long
&&&&On Error GoTo errHandler:
&&&&&&&&Application.EnableCancelKey = xlErrorHandler
&&&&&&&&bExitLoop = False
&&&&&&&&lXLhwnd = FindWindow("XLMAIN", Application.Caption)
&&&&&&&&WaitMessage
&&&&&&&&If PeekMessage _
&&&&&&&&&&&&(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
&&&&&&&&&&&&
&&&&&&&&&&&&iKeyCode = msgMessage.wParam
&&&&&&&&&&&
&&&&&&&&&&&&TranslateMessage msgMessage
&&&&&&&&&&&&PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
&&&&&&&&&&&&WM_CHAR, PM_REMOVE
&&&&&&&&&&&
&&&&&&&&&&
&&&&&&&&&&&&
&&&&&&&&&&&&If iKeyCode = vbKeyBack Then SendKeys "{BS}"
&&&&&&&&&&&&If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
&&&&&&&&&&&
&&&&&&&&&&&&bCancel = False
&&&&&&&&&&&&
&&&&&&&&&&&&
&&&&&&&&&&&&Sheet_KeyPress _
&&&&&&&&&&&&ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
&&&&&&&&&&&&
&&&&&&&&&&&&If bCancel = False Then
&&&&&&&&&&&&&&&&PostMessage _
&&&&&&&&&&&&&&&&lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
&&&&&&&&&&&&End If
&&&&&&&&End If
errHandler:
&&&&&&&&DoEvents
&&&&Loop Until bExitLoop
Sub StopKeyWatch()
&&&&bExitLoop = True
Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _
&&&&&&&&&&&&&&&&&&&&&&&&&&&ByVal KeyCode As Integer, _
&&&&&&&&&&&&&&&&&&&&&&&&&&&ByVal Target As Range, _
&&&&&&&&&&&&&&&&&&&&&&&&&&&Cancel As Boolean)
&&&&Const MSG As String = _
&&&&"Numeric Characters are not allowed in" & _
&&&&vbNewLine & "the Range:& """
&&&&Const TITLE As String = "Invalid Entry !"
&&&&If Not Intersect(Target, Range("A1:D10")) Is Nothing Then
&&&&&&&&If Chr(KeyAscii) Like "[0-9]" Then
&&&&&&&&&&&&MsgBox MSG & Range("A1:D10").Address(False, False) _
&&&&&&&&&&&&& """ .", vbCritical, TITLE
&&&&&&&&&&&&Cancel = True
&&&&&&&&End If
&&&&End If
在上述代码中，代码书写者自行添加了一个循环来不断的捕获、处理消息，来实现对KeyPress消息的处理，对性能有一定的影响。但整体代码运行比较稳定，是一种不错的选择。
[转]&[转]&
喜欢该文的人也喜欢Excel.VBA中可以实现对左键单击的识别吗？ - 知乎有问题，上知乎。知乎作为中文互联网最大的知识分享平台，以「知识连接一切」为愿景，致力于构建一个人人都可以便捷接入的知识分享网络，让人们便捷地与世界分享知识、经验和见解，发现更大的世界。2被浏览464分享邀请回答赞同 添加评论分享收藏感谢收起