标题: VB6拾遗:轻量级COM对象
作者: Demon
链接: http://demon.tw/programming/vb6-repick-light-weight-object.html
版权: 本博客的所有文章,都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。
在VB6中可以用类模块来实现COM对象,其实用UDT(用户定义类型)也可以。
COM只不过是一种二进制标准,只要能在内存中构造出符合这种标准的数据结构,就能实现COM对象。
以下代码摘自Matthew Curland的《Advanced Visual Basic 6》:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long) Const E_NOINTERFACE As Long = &H80004002 Private Type LightEmptyVTable VTable(2) As Long End Type Public Type LightEmpty pVTable As Long End Type Private m_VTable As LightEmptyVTable Private m_pVTable As Long Sub Main() Dim LE As LightEmpty InitializeLightEmpty LE End Sub Public Function InitializeLightEmpty(LE As LightEmpty) As IUnknown If m_pVTable = 0 Then With m_VTable .VTable(0) = FuncAddr(AddressOf QueryInterface) .VTable(1) = FuncAddr(AddressOf AddRef) .VTable(2) = FuncAddr(AddressOf Release) m_pVTable = VarPtr(.VTable(0)) End With End If With LE .pVTable = m_pVTable CopyMemory InitializeLightEmpty, VarPtr(.pVTable), 4 End With End Function Private Function QueryInterface _ (This As LightEmpty, riid As Long, pvObj As Long) As Long Debug.Assert False pvObj = 0 QueryInterface = E_NOINTERFACE End Function Private Function AddRef(This As LightEmpty) As Long Debug.Assert False End Function Private Function Release(This As LightEmpty) As Long MsgBox "LightEmpty->Release" End Function Private Function FuncAddr(ByVal pfn As Long) As Long FuncAddr = pfn End Function
用结构体(VB6中的户定义类型相当于C语言中的结构体)构造出COM对象,与Jeff Glatt的《COM in plain C》有异曲同工之妙。
问题是VB6为什么会自动调用Release函数?还是得看一下汇编代码:
004018A1 lea eax, [ebp-14] 004018A4 push eax 004018A5 call Module2::InitializeLightEmpty ; [Module2::InitializeLightEmpty 004018AA push eax ; /Arg2 004018AB lea eax, [ebp-18] ; | 004018AE push eax ; |Arg1 => offset LOCAL.6 004018AF call @__vbaObjSet ; \MSVBVM60.__vbaObjSet 004018B4 lea ecx, [ebp-18] 004018B7 call @__vbaFreeObj ; [MSVBVM60.__vbaFreeObj
关键在于InitializeLightEmpty函数的返回值类型是IUnknown,虽然我们并没有用变量保存返回值,但是VB还是会生成一个临时变量来保存。由于该变量的类型是对象,所以要调用__vbaFreeObj来释放对象,__vbaFreeObj内部会调用对象的Release方法,即我们在模块中定义的Release函数。
当然,这个例子并没有太大的实用价值,只不过相当于实现了一个有Class_Terminate事件的结构体。要想实现功能上可以和类模块相媲美的轻量级对象,还必须借助IDL。
比如我们要实现一个DemonBlog对象,该对象有一个Url属性和一个Open方法,可以这么做:
首先写一个IDL定义接口并用midl.exe编译成.tlb添加到VB引用:
[ uuid(EF6CB73E-01F6-42C9-A560-F3A1B92DC8F8), version(1.0) ] library DemonBlogLib { importlib("stdole2.tlb"); [ odl, uuid(7694E9F7-238E-43BC-B05F-34C08751E2E0), nonextensible ] interface IDemonBlog : IUnknown { [propget] HRESULT _stdcall Url([out, retval] BSTR* retVal); HRESULT _stdcall Open(); }; };
新建一个标准模块,代码如下:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteW" ( _ ByVal hwnd As Long, _ ByVal lpOperation As Long, _ ByVal lpFile As Long, _ ByVal lpParameters As Long, _ ByVal lpDirectory As Long, _ ByVal nShowCmd As Long) As Long Const E_NOINTERFACE As Long = &H80004002 Private Type DemonBlogVTable VTable(4) As Long End Type Public Type DemonBlog pVTable As Long End Type Private m_VTable As DemonBlogVTable Private m_pVTable As Long Public Function InitializeDemonBlog(LE As DemonBlog) As IDemonBlog If m_pVTable = 0 Then With m_VTable .VTable(0) = FuncAddr(AddressOf QueryInterface) .VTable(1) = FuncAddr(AddressOf AddRef) .VTable(2) = FuncAddr(AddressOf Release) .VTable(3) = FuncAddr(AddressOf GetUrl) .VTable(4) = FuncAddr(AddressOf OpenBlog) m_pVTable = VarPtr(.VTable(0)) End With End If With LE .pVTable = m_pVTable CopyMemory InitializeDemonBlog, VarPtr(.pVTable), 4 End With End Function Private Function QueryInterface _ (This As DemonBlog, riid As Long, pvObj As Long) As Long Debug.Assert False pvObj = 0 QueryInterface = E_NOINTERFACE End Function Private Function AddRef(This As DemonBlog) As Long Debug.Assert False End Function Private Function Release(This As DemonBlog) As Long MsgBox "DemonBlog->Release" End Function Private Function GetUrl(This As DemonBlog, Url As String) As Long Url = "http://demon.tw" End Function Private Function OpenBlog(This As DemonBlog) As Long ShellExecute 0, StrPtr("open"), StrPtr("http://demon.tw"), 0, 0, 1 End Function Private Function FuncAddr(ByVal pfn As Long) As Long FuncAddr = pfn End Function
再添加一个标准模块,代码如下:
Sub Main() Dim DB As DemonBlog Dim IDB As IDemonBlog Set IDB = InitializeDemonBlog(DB) MsgBox IDB.Url IDB.Open End Sub
然后可以运行看看效果如何,还不错吧?可能有人要问,用类模块几行代码搞定的事,这样费尽周折的使用轻量级对象到底有什么意义?如果我说这样效率更高(普通对象在堆上分配内存,轻量级对象在堆栈上分配内存),你一定会笑掉大牙。说实话,就本例而已,意义不大。但是不要小看轻量级对象,用它可以实现一些VB6看上去无法实现的东西。
随机文章:
awesome job! man,ur so cool & pro. expecting your next work.
Demon,我发现用dispcallfunc可以不借助IDL:
Sub Main()
Dim DB As DemonBlog
Dim IDB As IUnknown
Dim URL As String
Dim ret As Long
Set IDB = InitializeDemonBlog(DB)
Call DispCallFunc(ObjPtr(IDB), 12, 1, vbLong, 1, vbLong, VarPtr(VarPtr(URL)) – 8, ret)
Call DispCallFunc(ObjPtr(IDB), 16, 1, vbLong, 0, 0, 0, ret)
End Sub
怎么传递参数呢?