前几天有位网友问我用VB实现SHELL扩展的问题，这个问题比较有意思，虽然VB较少使用了，但是用VB开发COM组件还是比较方便的（前几天用EVC开发COM组件，相比起来，用VB还是比较幸福的），所以便进行了深入的研究。

Shell扩展有多种，而我们目前所关注的就是实现“IShellExecuteHookW ”接口的扩展，这个接口功能很强劲，只要是window加载相应程序，必须要过这一关，这样你就可以在程序执行之前预先获知要运行的进程名称，并且你可以决定该程序是否执行（瑞星杀毒软件就实现了这样一个组件，在程序运行之前，进行截获并杀毒）。

网上有位朋友用C#实现了该功能，链接如下：http://blog.csdn.net/startsoft/archive/2002/12/30/13417.aspx，写的很详细，不过我没有用C#做一遍，是否有效不好说。

从内容上看实现该功能应该比较容易，然而上帝是公平的，用VB虽然编写COM组件比较容易，但却在实现过程中，为VB设下一个又一个难关，下面我一一道来！

1、 接口函数为过程，不是函数，不能返回值

这是VB默认生成的接口函数，如果强制修改为Function，则编译无法通过。

Public Sub IShellExecuteHookW_Execute(pei As olelib.SHELLEXECUTEINFO)

End Sub

而恰恰是，实现该功能必须要返回值，实际发现，该过程虽然没有返回值，但是对调用者来说，返回的是S_OK，这样，所有的程序都无法启动，因为只有返回值为S_FALSE时，才允许可执行文件运行。

不过，如果过程中显示路径信息的话，是可以正确显示的（也就是说可以截获程序运行信息）。

2、 另辟蹊径，用黑客技术实现函数返回

查了n多资料，发现有如下实现方法：

‘-------类中的代码------------

Implements IShellExecuteHookW

Private m_pOldIShellExecuteHookW As Long

Private Sub Class_Initialize()

    Dim pShellExecuteHookW As IShellExecuteHookW

    Set pShellExecuteHookW = Me

    '把“IShellExecuteHookW_Execute”接口函数替换为“Execute”

    m_pOldIShellExecuteHookW = SwapVtableEntry(ObjPtr(pShellExecuteHookW), 4, AddressOf Execute)

End Sub

Public Sub IShellExecuteHookW_Execute(pei As olelib.SHELLEXECUTEINFO)

    '空接口，实际并不执行，因为已转入Execute 中执行

End Sub

‘---------模块中的代码---------------

Public Function Execute(pei As olelib.SHELLEXECUTEINFO) As HRESULTS

   ‘新接口，如果接口被调用，则执行该函数体内的代码

End Sub

Public Function SwapVtableEntry(pObj As Long, EntryNumber As Integer, ByVal lpfn As Long) As Long

    Dim lOldAddr As Long

    Dim lpVtableHead As Long

    Dim lpfnAddr As Long

    Dim lOldProtect As Long

    CopyMemory lpVtableHead, ByVal pObj, 4

    lpfnAddr = lpVtableHead + (EntryNumber - 1) * 4

    CopyMemory lOldAddr, ByVal lpfnAddr, 4

    Call VirtualProtect(lpfnAddr, 4, PAGE_EXECUTE_READWRITE, lOldProtect)

    CopyMemory ByVal lpfnAddr, lpfn, 4

    Call VirtualProtect(lpfnAddr, 4, lOldProtect, lOldProtect)

    SwapVtableEntry = lOldAddr

End Function

从以上代码可以看出，在COM组件被初始化时，把原接口函数的地址换成新接口地址，使我们自定义的接口函数取代原函数。

注意上面的代码，在模块中接口“Execute”已经是函数形式，可以返回值了

至于SwapVtableEntry函数第二个参数为什么是4，我也不清楚，我看过其他相关例程，什么数字的都有，不过一般都是4，我实际测试过，如果不是4，有种情况是原类中的接口和模块中的“Execute”会先后执行的（有的甚至会执行几次）。

这个时候，编译加载，你发现是可以通过不同的返回值，来决定刚打开的程序是否运行的，不过命运之神偏偏又捉弄我们，Execute函数的参数值有问题，无法正确的显示程序信息。

3、柳暗花明

刚开始我以为是SwapVtableEntry第二个参数在搞怪，从0测试到11，都不行，反而把Windows搞死好几次。

后来把pei As olelib.SHELLEXECUTEINFO参数定义为lPei as long 型，通过内存拷贝，进行类型赋值也不行。

实际发现pei. cbSize参数为结构体的大小，固定为60，所以我把该参数的前后64个字节全看了个遍，也没有发现有60的，实在没有办法了，我又仔细看了看用C#实现的代码：

1. public class ExtenShell : IShellExecuteHook   
2.       {  
3.            private int S_OK=0;  
4.            private int S_FALSE=1;  
5.            public int Execute(SHELLEXECUTEINFO sei)   
6.            {  
7.                try   
8.                {   
9.                    MessageBox.Show(null, "[ Verb ]: " + sei.lpVerb + "\n[ File ]: " + sei.lpFile + "\n[ Parameters ]:" + sei.lpParameters + "\n[ Directory ]:" + sei.lpDirectory , "ShellExtensionHook",MessageBoxButtons.OK, MessageBoxIcon.Information);   
10.  
11.                }   
12.                catch(Exception e)   
13.                {  
14.                    Console.Error.WriteLine("Unknown exception : " + e.ToString());  
15.                }  
16.  
17.                return S_FALSE;  
18.                //如果返回值为S_OK则SHELL将停止对Shell对象的以后的所有动作。  
19.             }  
20.        }  
21.  

用C#实现很简单，直接实现public int Execute(SHELLEXECUTEINFO sei)接口就可以了，看着看着，突然，灵光一现，接口Execute为类中的函数，而在VB中新的接口函数放在模块中，普通函数和类中函数是有区别的，那就是类中的函数的第一个参数为隐含参数，也就是this指针，一般指针的长度为4个字节，在VB中也就是long型，好，重新把VB模块中函数声明如下：

Public Function Execute(this As Long, pei As olelib.SHELLEXECUTEINFO) As HRESULTS

End Function

注意，新添加了this As Long参数，好，编译测试，OK，成功！！！

完整代码如下：

1、类中代码：

1. '*************************************************************************  
2. '**模 块 名：CShellHook  
3. '**说    明：YFsoft 版权所有2007 - 2008(C)  
4. '**创 建 人：叶帆  
5. '**日    期：2007-08-23 13:20:11  
6. '**修 改 人：  
7. '**日    期：  
8. '**描    述：叶帆工作室  
9. '**版    本：V1.0.0  
10. '*************************************************************************  
11. Option Explicit  
12. Implements IShellExecuteHookW  
13. Private m_pOldIShellExecuteHookW As Long  
14.  
15. '*************************************************************************  
16. '**函 数 名：Class_Initialize  
17. '**输    入：无  
18. '**输    出：无  
19. '**功能描述：类初始化  
20. '**全局变量：  
21. '**调用模块：  
22. '**作    者：叶帆  
23. '**日    期：2007-08-23 13:20:09  
24. '**修 改 人：  
25. '**日    期：  
26. '**版    本：V1.0.0  
27. '*************************************************************************  
28. Private Sub Class_Initialize()  
29.     Dim pShellExecuteHookW As IShellExecuteHookW  
30.     Set pShellExecuteHookW = Me 
31.     '把“IShellExecuteHookW_Execute”接口函数替换为“Execute”  
32.     m_pOldIShellExecuteHookW = SwapVtableEntry(ObjPtr(pShellExecuteHookW), 4, AddressOf Execute)  
33. End Sub  
34.  
35. '*************************************************************************  
36. '**函 数 名：IShellExecuteHookW_Execute  
37. '**输    入：pei(olelib.SHELLEXECUTEINFO) -  
38. '**输    出：无  
39. '**功能描述：接口函数（为空）  
40. '**全局变量：  
41. '**调用模块：  
42. '**作    者：叶帆  
43. '**日    期：2007-08-23 13:20:24  
44. '**修 改 人：  
45. '**日    期：  
46. '**版    本：V1.0.0  
47. '*************************************************************************  
48. Public Sub IShellExecuteHookW_Execute(pei As olelib.SHELLEXECUTEINFO)  
49.     '已转入Execute 中执行  
50. End Sub  
51.  
52. '*************************************************************************  
53. '**函 数 名：Class_Terminate  
54. '**输    入：无  
55. '**输    出：无  
56. '**功能描述：类销毁  
57. '**全局变量：  
58. '**调用模块：  
59. '**作    者：叶帆  
60. '**日    期：2007-08-23 13:20:19  
61. '**修 改 人：  
62. '**日    期：  
63. '**版    本：V1.0.0  
64. '*************************************************************************  
65. Private Sub Class_Terminate()  
66.    Dim pShellExecuteHookW As IShellExecuteHookW  
67.    Set pShellExecuteHookW = Me 
68.    m_pOldIShellExecuteHookW = SwapVtableEntry(ObjPtr(pShellExecuteHookW), 4, m_pOldIShellExecuteHookW)  
69. End Sub  
70.  
71. 2、模块中的代码  
72.  
73. '*************************************************************************  
74. '**模 块 名：ShellHook  
75. '**说    明：YFsoft 版权所有2007 - 2008(C)  
76. '**创 建 人：叶帆  
77. '**日    期：2007-08-23 13:23:52  
78. '**修 改 人：  
79. '**日    期：  
80. '**描    述：叶帆工作室 http://blog.csdn.net/yefanqiu  
81. '**版    本：V1.0.0  
82. '*************************************************************************  
83. Option Explicit  
84. Public Const E_NOTIMPL = &H80004001  
85. Public Const PAGE_EXECUTE_READWRITE = &H40&  
86. Public Const S_FALSE = 1 
87. Public Const S_OK = 0 
88.  
89. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)  
90. Public Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, ByRef lpflOldProtect As Long) As Long  
91.  
92. Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long  
93. Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long  
94.  
95. Private Declare Function lstrcpyA Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long  
96. Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long  
97.  
98. '*************************************************************************  
99. '**函 数 名：Execute  
100. '**输    入：this(Long)                   - 类的this指针  
101. '**        ：pei(olelib.SHELLEXECUTEINFO) - 参数  
102. '**输    出：(HRESULTS) -  
103. '**功能描述：被替换的接口函数  
104. '**全局变量：  
105. '**调用模块：  
106. '**作    者：叶帆  
107. '**日    期：2007-08-23 13:23:56  
108. '**修 改 人：  
109. '**日    期：  
110. '**版    本：V1.0.0  
111. '*************************************************************************  
112. Public Function Execute(this As Long, pei As olelib.SHELLEXECUTEINFO) As HRESULTS  
113.     Dim strInfo As String  
114.  
115.     strInfostrInfo = strInfo + "cbSize" + str(pei.cbSize) + vbCrLf  
116.     strInfostrInfo = strInfo + "fMask" + str(pei.fMask) + vbCrLf  
117.     strInfostrInfo = strInfo + "hInstApp" + str(pei.hInstApp) + vbCrLf  
118.     strInfostrInfo = strInfo + "hwnd" + str(pei.hwnd) + vbCrLf  
119.     strInfostrInfo = strInfo + "lpDirectory" + StrFromPtr(pei.lpDirectory, True) + vbCrLf  
120.     strInfostrInfo = strInfo + "lpFile" + StrFromPtr(pei.lpFile, True) + vbCrLf  
121.     strInfostrInfo = strInfo + "lpParameters" + StrFromPtr(pei.lpParameters, True) + vbCrLf  
122.     strInfostrInfo = strInfo + "lpVerb" + StrFromPtr(pei.lpVerb, True) + vbCrLf  
123.     strInfostrInfo = strInfo + "nShow" + str(pei.nShow) + vbCrLf  
124.  
125.     MsgBox strInfo  
126.  
127.     If MsgBox("允许'" + StrFromPtr(pei.lpFile, True) + "'程序执行吗?", vbQuestion + vbOKCancel, "程序运行监控") = vbOK Then  
128.         Execute = S_FALSE 
129.     Else  
130.         Execute = S_OK 
131.     End If  
132. End Function  
133.  
134. '*************************************************************************  
135. '**函 数 名：SwapVtableEntry  
136. '**输    入：pObj(Long)           - 类对象初始地址  
137. '**        ：EntryNumber(Integer) - 入口函数索引  
138. '**        ：ByVal lpfn(Long)     - 新函数  
139. '**输    出：(Long) - 原函数地址  
140. '**功能描述：更换接口函数  
141. '**全局变量：  
142. '**调用模块：  
143. '**作    者：叶帆  
144. '**日    期：2007-08-23 13:24:26  
145. '**修 改 人：  
146. '**日    期：  
147. '**版    本：V1.0.0  
148. '*************************************************************************  
149. Public Function SwapVtableEntry(pObj As Long, EntryNumber As Integer, ByVal lpfn As Long) As Long  
150.  
151.     Dim lOldAddr As Long  
152.     Dim lpVtableHead As Long  
153.     Dim lpfnAddr As Long  
154.     Dim lOldProtect As Long  
155.  
156.     CopyMemory lpVtableHead, ByVal pObj, 4  
157.     lpfnAddr = lpVtableHead + (EntryNumber - 1) * 4  
158.     CopyMemory lOldAddr, ByVal lpfnAddr, 4  
159.  
160.     Call VirtualProtect(lpfnAddr, 4, PAGE_EXECUTE_READWRITE, lOldProtect)  
161.     CopyMemory ByVal lpfnAddr, lpfn, 4  
162.     Call VirtualProtect(lpfnAddr, 4, lOldProtect, lOldProtect)  
163.  
164.     SwapVtableEntry = lOldAddr 
165.  
166. End Function  
167.  
168. '*************************************************************************  
169. '**函 数 名：StrFromPtr  
170. '**输    入：ByVal lpString(Long)               - 字符串指针  
171. '**        ：Optional fUnicode(Boolean = False) - 字符格式  
172. '**输    出：(String) - 字符串  
173. '**功能描述：转换字符串  
174. '**全局变量：  
175. '**调用模块：  
176. '**作    者：叶帆  
177. '**日    期：2007-08-23 13:24:28  
178. '**修 改 人：  
179. '**日    期：  
180. '**版    本：V1.0.0  
181. '*************************************************************************  
182. Public Function StrFromPtr(ByVal lpString As Long, Optional fUnicode As Boolean = False) As String  
183.     On Error Resume Next  
184.     If fUnicode Then  
185.         StrFromPtr = String(lstrlenW(lpString), Chr(0))  
186.         lstrcpyW StrPtr(StrFromPtr), ByVal lpString  
187.     Else  
188.         StrFromPtr = String(lstrlenA(lpString), Chr(0))  
189.         lstrcpyA ByVal StrFromPtr, ByVal lpString  
190.     End If  
191.  End Function

 

注：要实现在程序运行截获，必须在注册表添加如下项（如下图），字符串为COM的GUID，VB中生成的COM的GUID，你可以在注册表中搜索获取，也可以用专门的工具直接查看（我用的工具是，RegCtrls.exe），当然也可以新建VB工程引用你的COM组件，保存后，用文本编辑器打开工程文件，查看相应GUID信息。

 

程序在浏览器被双击运行后，会提前弹出如下对话框（此外程序中调用的进程，也会显示该对话框），这时候该程序运不运行就你说了算了。别说和Vista中安全机制还真有些像，需要用户确认下才能运行：）

 

 

 

本文转自yefanqiu51CTO博客，原文链接：http://blog.51cto.com/yfsoft/323471，如需转载请自行联系原作者