VB实现SHELL扩展之接口参数获取失败探析

news/2024/7/6 4:57:25

前几天有位网友问我用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#实现的代码:

public class ExtenShell : IShellExecuteHook
      {
           private int S_OK=0;
           private int S_FALSE=1;
           public int Execute(SHELLEXECUTEINFO sei)
           {
               try
               {
                   MessageBox.Show(null, "[ Verb ]: " + sei.lpVerb + "/n[ File ]: " + sei.lpFile + "/n[ Parameters ]:" + sei.lpParameters + "/n[ Directory ]:" + sei.lpDirectory , "ShellExtensionHook",MessageBoxButtons.OK, MessageBoxIcon.Information);

               }
               catch(Exception e)
               {
                   Console.Error.WriteLine("Unknown exception : " + e.ToString());
               }

               return S_FALSE;
               //
如果返回值为S_OKSHELL将停止对Shell对象的以后的所有动作。
            }
       }

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、类中代码:

' *************************************************************************
'
**模 块 名:CShellHook
'
**说    明:YFsoft 版权所有2007 - 2008(C)
'
**创 建 人:叶帆
'
**日    期:2007-08-23 13:20:11
'
**修 改 人:
'
**日    期:
'
**描    述:叶帆工作室 http://blog.csdn.net/yefanqiu
'
**版    本:V1.0.0
'
*************************************************************************
Option   Explicit
Implements IShellExecuteHookW
Private  m_pOldIShellExecuteHookW  As   Long

' *************************************************************************
'
**函 数 名:Class_Initialize
'
**输    入:无
'
**输    出:无
'
**功能描述:类初始化
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:20:09
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
Private   Sub  Class_Initialize()
    
Dim  pShellExecuteHookW  As  IShellExecuteHookW
    
Set  pShellExecuteHookW  =  Me
    
' 把“IShellExecuteHookW_Execute”接口函数替换为“Execute”
    m_pOldIShellExecuteHookW  =  SwapVtableEntry(ObjPtr(pShellExecuteHookW),  4 , AddressOf  Execute )
End Sub

' *************************************************************************
'
**函 数 名:IShellExecuteHookW_Execute
'
**输    入:pei(olelib.SHELLEXECUTEINFO) -
'
**输    出:无
'
**功能描述:接口函数(为空)
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:20:24
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
Public   Sub  IShellExecuteHookW_Execute(pei  As  olelib.SHELLEXECUTEINFO)
    
' 已转入Execute 中执行
End Sub

' *************************************************************************
'
**函 数 名:Class_Terminate
'
**输    入:无
'
**输    出:无
'
**功能描述:类销毁
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:20:19
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
Private   Sub  Class_Terminate()
   
Dim  pShellExecuteHookW  As  IShellExecuteHookW
   
Set  pShellExecuteHookW  =  Me
   m_pOldIShellExecuteHookW 
=  SwapVtableEntry(ObjPtr(pShellExecuteHookW),  4 , m_pOldIShellExecuteHookW)
End Sub

2、模块中的代码

' *************************************************************************
'
**模 块 名:ShellHook
'
**说    明:YFsoft 版权所有2007 - 2008(C)
'
**创 建 人:叶帆
'
**日    期:2007-08-23 13:23:52
'
**修 改 人:
'
**日    期:
'
**描    述:叶帆工作室 http://blog.csdn.net/yefanqiu
'
**版    本:V1.0.0
'
*************************************************************************
Option   Explicit
Public   Const  E_NOTIMPL  =   & H80004001
Public   Const  PAGE_EXECUTE_READWRITE  =   & H40 &
Public   Const  S_FALSE  =   1
Public   Const  S_OK  =   0

Public  Declare  Sub  CopyMemory Lib  " kernel32 "  Alias  " RtlMoveMemory "  (pDest  As  Any, pSource  As  Any, ByVal ByteLen  As   Long )
Public  Declare  Function  VirtualProtect Lib  " kernel32 "  (ByVal lpAddress  As   Long , ByVal dwSize  As   Long , ByVal flNewProtect  As   Long , ByRef lpflOldProtect  As   Long As   Long

Private  Declare  Function  lstrlenA Lib  " kernel32 "  (ByVal lpString  As   Long As   Long
Private  Declare  Function  lstrlenW Lib  " kernel32 "  (ByVal lpString  As   Long As   Long

Private  Declare  Function  lstrcpyA Lib  " kernel32 "  (ByVal lpString1  As   Long , ByVal lpString2  As   Long As   Long
Private  Declare  Function  lstrcpyW Lib  " kernel32 "  (ByVal lpString1  As   Long , ByVal lpString2  As   Long As   Long

' *************************************************************************
'
**函 数 名:Execute
'
**输    入:this(Long)                   - 类的this指针
'
**        :pei(olelib.SHELLEXECUTEINFO) - 参数
'
**输    出:(HRESULTS) -
'
**功能描述:被替换的接口函数
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:23:56
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
Public   Function   Execute (this  As   Long , pei  As  olelib.SHELLEXECUTEINFO)  As  HRESULTS
    
Dim  strInfo  As   String

    strInfo 
=  strInfo  +   " cbSize "   +  str(pei.cbSize)  +  vbCrLf
    strInfo 
=  strInfo  +   " fMask "   +  str(pei.fMask)  +  vbCrLf
    strInfo 
=  strInfo  +   " hInstApp "   +  str(pei.hInstApp)  +  vbCrLf
    strInfo 
=  strInfo  +   " hwnd "   +  str(pei.hwnd)  +  vbCrLf
    strInfo 
=  strInfo  +   " lpDirectory "   +  StrFromPtr(pei.lpDirectory,  True +  vbCrLf
    strInfo 
=  strInfo  +   " lpFile "   +  StrFromPtr(pei.lpFile,  True +  vbCrLf
    strInfo 
=  strInfo  +   " lpParameters "   +  StrFromPtr(pei.lpParameters,  True +  vbCrLf
    strInfo 
=  strInfo  +   " lpVerb "   +  StrFromPtr(pei.lpVerb,  True +  vbCrLf
    strInfo 
=  strInfo  +   " nShow "   +  str(pei.nShow)  +  vbCrLf

    
MsgBox  strInfo

     If   MsgBox ( " 允许' "   +  StrFromPtr(pei.lpFile,  True +   " '程序执行吗? " , vbQuestion  +  vbOKCancel,  " 程序运行监控 " =  vbOK  Then
        
Execute   =  S_FALSE
    
Else
        
Execute   =  S_OK
    
End   If
End Function

' *************************************************************************
'
**函 数 名:SwapVtableEntry
'
**输    入:pObj(Long)           - 类对象初始地址
'
**        :EntryNumber(Integer) - 入口函数索引
'
**        :ByVal lpfn(Long)     - 新函数
'
**输    出:(Long) - 原函数地址
'
**功能描述:更换接口函数
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:24:26
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
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

' *************************************************************************
'
**函 数 名:StrFromPtr
'
**输    入:ByVal lpString(Long)               - 字符串指针
'
**        :Optional fUnicode(Boolean = False) - 字符格式
'
**输    出:(String) - 字符串
'
**功能描述:转换字符串
'
**全局变量:
'
**调用模块:
'
**作    者:叶帆
'
**日    期:2007-08-23 13:24:28
'
**修 改 人:
'
**日    期:
'
**版    本:V1.0.0
'
*************************************************************************
Public   Function  StrFromPtr(ByVal lpString  As   Long , Optional fUnicode  As   Boolean   =   False As   String
    
On   Error   Resume   Next
    
If  fUnicode  Then
        StrFromPtr 
=   String (lstrlenW(lpString),  Chr ( 0 ))
        lstrcpyW StrPtr(StrFromPtr), ByVal lpString
    
Else
        StrFromPtr 
=   String (lstrlenA(lpString),  Chr ( 0 ))
        lstrcpyA ByVal StrFromPtr, ByVal lpString
    
End   If
End Function

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

 

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

 

 





http://www.niftyadmin.cn/n/3655822.html

相关文章

js 排序学习

冒泡排序 Array.prototype.bubbleSort function() {// console.log(this)for (let i 0; i < this.length - 1; i) {for(let j 0;j<this.length -1 - i; j1){ // -1 可以用j1来获取 - i是为了缩小循环节省时间if(this[j] > this[j1]){const temp this[j] // …

16进制字符串转数字(C/C++,VB/VB.net,C#)

这个问题看是很简单&#xff0c;但是在不同语言中实现的方式却千差万别&#xff0c;如果不知道方法&#xff0c;还真是麻烦&#xff0c;我就是在C#中遇到该问题&#xff0c;让我费了很大的周折&#xff0c;才在msdn查到。一、16进制字符串转数字1、C/CI、最简单的办法&#xff…

面试题 ---快速排序的空间复杂度是多少?时间复杂度的最好最坏的情况是多少,有哪些优化方案?

Array.prototype.quickSort function() {const rec (arr) >{if(arr.length 1){return arr}// 分别存放 前后的数组const left []const right []// 设置一个基准const mid arr[0]//进行分区for(let i 1; i<arr.length; i1){if(arr[i] < mid){left.push(arr[i])}el…

如何加速XML反序列化(精简框架集2.0SP1,WinCE4.2) -- 寻求微软技术支持记

其实这个问题在2007/3/13 就提交到了微软技术支持&#xff0c;但直到今天&#xff0c;对这个问题还没有一个完美的结果&#xff08;他们最好的建议就是&#xff0c;自己解析XML文件&#xff09;&#xff0c;只好请求微软的技术支持把这个问题close掉。问题的关键在于&#xff1…

面试题---------简述 LRU 算法及其实现方式

简述 LRU 算法 一种比较常见的缓存算法&#xff0c;也是内存管理使用的一种算法。在内存满的时候&#xff0c;选择内存中最近最久未使用的页面予以淘汰。 实现方式 哈希表 双向链表 双向链表按照被使用的顺序存储了这些键值对&#xff0c;靠近头部的键值对是最近使用的&…

简述图片的懒加载原理

懒加载原理 一张图片就是一个<img>标签&#xff0c;浏览器是否发起请求图片是根据<img>的src属性&#xff0c;所以实现懒加载的关键就是&#xff0c;在图片没有进入可视区域时&#xff0c;先不给<img>的src赋值&#xff0c;这样浏览器就不会发送请求了&…

ActiveSync用红外接口PC与掌上电脑同步

用了三年多的IBM老本终于退居二线了&#xff0c;别说还真有些舍不得。幸好新买的HP Compaq nc4400的小本接口比较齐全 &#xff0c;算是一种心理上的补偿&#xff0c;唯感到遗憾的是自带Vista home版&#xff0c;用起来实在别扭&#xff0c;买后的第二天就把盘格了&#xff0c;…