|
入具有不同行为的函数来动态改变某段代码的行为。我们也可以通过这种技术在VB里实现type casting（强制类型转换）（译者：通过VarPtr得到一个变量的无类型指针，然后将这个指针做为参数，将这个指针传给不同的类型转换函数指针，并调用之，即可实现强制类型转换）。我不可能把所有可能的应用都列出来，但是这里我再来演示一段小程序。
我们经常想在调试已编译的VB组件时，能在捕获一个错误的同时跳到调试器内。标准的方法就是运行Int3命令，这时会出现一个系统异常对话框来让我们选择是起动调试器还是直接结束崩溃的程序。我们需要运行的函数有两条汇编指令：break（Int3）和return(ret)。相应的ASM指令为CC和C3。用下面来代码来实现一个这样的FunctionDelegator：
Dim FDVoid As FunctionDelegator
Dim CallVoid As ICallVoid
Dim Int3Ret As Integer
Int3Ret = &HC3CC
Set CallVoid = InitDelegator( _
FDVoid, VarPtr(Int3Ret))
''''中断并进入调试器
CallVoid.Void
在VB里的In-line assembly（线内汇编）代码给VB的表达能力提供了无限的可能性（译者：实际上这和C里的线内汇编有很大不同，我们只能插入机器代码，我觉得此处称为In-Line Machine Code线内机器代码更合适）。 我们这里演示的函数实际上和DebugBreak这个API的功能是一样的（译者：仅就这个函数的功能来说还不如直接用DebugBreak），但是实现别的功能就不是这么简单了。如果我们需要更多的字节，可以用一个Long或Currency数组来填字节流，并用VarPtr取得指向数组第0个元素的指针来作为函数指针。
（全文完）
Listing 1 这段代码将一个FunctionDelegator转换成一个支持特定函数指针的COM对象。这是一个特殊的COM对象，因为它不要求任何内存分配并且对我们的接口请求总是盲目合作。请求仅有的正确接口是我们的责任。
''''The magic number
Private Const cDelegateASM _
As Currency = -368956918007638.6215@
''''到处到用的辅助函数
Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private m_DelegateASM As Currency
''''vTable的类型声明
Private Type DelegatorVTables
''''OKQI vtable in 0 to 3, FailQI vtable in 4 to 7
VTable(7) As Long
End Type
Private m_VTables As DelegatorVTables
''''指向vtable的指针, 成功QI
Private m_pVTableOKQI As Long
''''指向vtable的指针, 失败QI
Private m_pVTableFailQI As Long
''''函数指针代理的结构声明
Public Type FunctionDelegator
pVTable As Long ''''This has to stay at offset 0
pfn As Long ''''This has to stay at offset 4
End Type
''''初始化FunctionDelegator结构，并将指向它的指针
'''' 作为一个COM对象返回.
Public Function InitDelegator( _
Delegator As FunctionDelegator, _
Optional ByVal pfn As Long) As IUnknown
''''第一次访问时初始化vTable
If m_pVTableOKQI = 0 Then InitVTables
With Delegator
.pVTable = m_pVTableOKQI
.pfn = pfn
End With
CopyMemory InitDelegator, VarPtr(Delegator), 4
End Function
''''初始化vTable
Private Sub InitVTables()
Dim pAddRefRelease As Long
With m_VTables
.VTable(0) = _
FuncAddr(AddressOf QueryInterfaceOK)
.VTable(4) = _
FuncAddr(AddressOf QueryInterfaceFail)
pAddRefRelease = FuncAddr(AddressOf AddRefRelease)
.VTable(1) = pAddRefRelease
.VTable(5) = pAddRefRelease
.VTable(2) = pAddRefRelease
.VTable(6) = pAddRefRelease
m_DelegateASM = cDelegateASM
.VTable(3) = VarPtr(m_DelegateASM)
.VTable(7) = .VTable(3)
m_pVTableOKQI = VarPtr(.VTable(0))
m_pVTableFailQI = VarPtr(.VTable(4))
End With
End Sub
''''成功QI
Private Function QueryInterfaceOK( _
This As FunctionDelegator, _
riid As Long, pvObj As Long) As Long
''''对第一次请求总是盲目合作
pvObj = VarPtr(This)
''''交换成失败时vTable，仅在调用函数指针会返回HRESULT错误代码
'''' 时才需要这么做，当然这么做总是更安全。
This.pVTable = m_pVTableFailQI
End Function
Private Function AddRefRelease( _
ByVal This As Long) As Long
''''什么都不做，无需要引用计数。
End Function
''''失败QI
Private Function QueryInterfaceFail( _
ByVal This As Long, _
riid As Long, pvObj As Long) As Long
''''对任何请求都说："不"
pvObj = 0
QueryInterfaceFail = &H80004002 ''''E_NOINTERFACE
End Function
''''返回函数指针的辅助函数
Private Function FuncAddr (ByVal pfn As Long) As Long
FuncAddr = pfn
End Function
译者：上面的代码在原文已经发表后经过了修改，因此原文没有提到为什么上面的代码需要两个不同的vTable。Matt在更新的示例代码的Readme文件里解释这个原因。我下面将这个原因简单的叙述如下：
这是因为当调用的函数指针需要返回HRESULT错误代码时，VB会用再次调用QI来向对象请求一个ISupportErrorInfo接口的引用。但是，由于原来代码里的QI完全采用盲目合作的信任方式，它总是返回对象自身的接口指针，哪怕它并不支持所要求的接口。由于返回的接口引用并不支持ISupportErrorInfo，所以当VB试图用ISupportErrorInfo的方法来搜集错误信息时程序就会崩溃。解决的办法，就是提供两个vTable。当第一次调用初始化后的vTable里的QI时，它采取信任方式返回接口指针，并在返回之前将包含失败QI的vTable交换进来。这样下一次访问的QI将是失败QI，而失败QI拒绝所有接口请求，这样就有效的阻塞了后继的QI请求，包括VB对ISupportErrorInfo的请求。在后面的Listing3的代码中我们可以看到，一旦我们增加引用就会有类型不匹配错误。
还有VB在对Err对象的处理上有BUG，那就是当VB用QI向某个对象请求ISupportErrorInfo接口失败后，Err对象内总是保留着对这个对象的引用。由于我们的vTalbe会先于Err对象释放，所以Err对象里有一个挂起的引用，当释放Err对象时程序会崩溃。解决的方法是：在程序结束前自己用Err.Raise来引发一个新错误。具体做法，见源代码。
Listing 2 用来告诉VB编译怎样调用我们的函数指针的外部ODL文件。没有对这个接口的描述，我们虽仍能生成代理到正确函数指针的COM对象，但却没有办法来调用vTable里的函数。
[
uuid(57EC3F60-5425-11d3-AB5C-D41203C10000),
helpstring("Function pointer declarations"),
lcid(0x0),
version(1.0)
]
library FuncDeclLib
{
importlib("stdole2.tlb");
[uuid(57EC3F61-5425-11d3-AB5C-D41203C10000), odl]
interface ICallCompare : IUnknown
{
long Compare(
[in] long Elem1,
[in] long Elem2);
}
[uuid(57EC3F62-5425-11d3-AB5C-D41203C10000), odl]
interface ICallHRESULTNoParams : IUnknown
{
HRESULT Call();
}
[uuid(57EC3F63-5425-11d3-AB5C-D41203C10000), odl]
interface ICallVoid : IUnknown
{
void Void();
}
}
Listing 3 为了实现标准的ActiveX DLL和OCX的注册，我们需要将DLL装入内存，找到用来注册的入口函数指针，然后再调用这个指针。通过使用FunctionDelegator对象，我们能对任意的DLL进行同样的操作。
Private Declare Function LoadLibrary _
Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Public Sub DllRegisterServer(DllName As String)
CallDllRegEntry DllName, "DllRegisterServer"
End Sub
Public Sub DllUnregisterServer(DllName As String)
CallDllRegEntry DllName, "DllUnregisterServer"
End Sub
Private Sub CallDllRegEntry (DllName As String, _
EntryPoint As String)
Dim pCall As ICallHRESULTNoParams
Dim Delegator As FunctionDelegator
Dim hMod As Long
Dim pfn As Long
''''Load the dll
hMod = LoadLibrary(DllName)
If hMod = 0 Then Err.Raise 5
''''Error trap to make sure we free the library
On Error GoTo Error
''''找到函数指针
pfn = GetProcAddress(hMod, EntryPoint)
If pfn = 0 Then Err.Raise 5
''''初始化并得到代理COM对象的引用。
Set pCall = InitDelegator(Delegator, pfn)
''''调用函数指针
pCall.Call
''''''''*****译者：取消注释下面部分可以来体验文中所说错误和崩溃
'''' Set pCall = Nothing
'''' Dim pIUn As IUnknown, pShape2 As Shape
'''' Set pIUn = InitDelegator(Delegator, pfn)
'''' Dim pCallVoid As ICallVoid
'''' Set pCallVoid = pIUn
''''
''''''''类型不匹配错误，因为此时QI已经被换成了失败QI。
'''' ''''Set pShape2 = pIUn
'''' Set pIUn = Nothing
'''' Set pCallVoid = Nothing
''''
''''''''崩溃，因为接口定义和函数指针不符
'''' ''''Set pShape2 = InitDelegator(Delegator, pfn)
''''''''**********************************************************
Error:
''''Free the library handle
FreeLibrary hMod
''''Propagate any error
With Err
If .Number Then .Raise .Number
End With
End Sub
上一页 [1] [2]
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
