日志
輕量級(jí)lightweight的com類
熱度 4 |
我在邪門武器之四中曾經(jīng)談過輕量級(jí)的com類，其實(shí)這是一個(gè)非常長(zhǎng)的話題。
輕量級(jí)的com類能夠帶來一些好處：
1、穩(wěn)定的函數(shù)指針（其實(shí)vba的函數(shù)指針有好多種方法，多得讓你有點(diǎn)迷惑）
2、實(shí)例化類的性能成百倍的提升
3、內(nèi)存占用小
4、讓類的繼承成為可能（手工繼承，而不是編譯器級(jí)繼承）
5、前期綁定無須引用類型庫（ocx除外）
……
以后有空余時(shí)間慢慢寫吧
第一種情況：純手工輕量級(jí)Com類
（1）建立標(biāo)準(zhǔn)模塊：modComhelper
Option Explicit
Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&) '分配對(duì)象內(nèi)存的api函數(shù)
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&) '釋放對(duì)象時(shí)清除內(nèi)存
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4) 'copyMemory函數(shù)，這是太有名了。
Function FuncPtr(ByVal Addr As Long) As Long '返回函數(shù)指針，配合addressof使用
FuncPtr = Addr
End Function
（2）建立標(biāo)準(zhǔn)模塊：modMyClassdef
Option Explicit
Private Type tMyCOMcompatibleVTable
'iUnknown接口必須要有三個(gè)方法，這是固定死了。這里定義是這三個(gè)方法的指針（long)
QueryInterface As Long
AddRef As Long
Release As Long
'自定義類的方法、屬性，這里只有一個(gè)addTowLongs函數(shù)，也是一個(gè)指針（long）
AddTwoLongs As Long
End Type
Private mVTable As tMyCOMcompatibleVTable '在棧上（而不是在堆上）預(yù)分配Vtable的內(nèi)存
Public Function VTablePtr() As Long '這是唯一的對(duì)外定義的函數(shù)，用來返回mVtable的首地址 (會(huì)在 modMyClassFactory中調(diào)用)
If mVTable.QueryInterface = 0 Then InitVTable '初始化
VTablePtr = VarPtr(mVTable) 'Vtableptr指針指向mVtable的首地址
End Function
Private Sub InitVTable() '初始化Vtable只能調(diào)用一次
mVTable.QueryInterface = FuncPtr(AddressOf modMyClassFactory.QueryInterface)
mVTable.AddRef = FuncPtr(AddressOf modMyClassFactory.AddRef)
mVTable.Release = FuncPtr(AddressOf modMyClassFactory.Release)
mVTable.AddTwoLongs = FuncPtr(AddressOf modMyClassFactory.AddTwoLongs)
End Sub
（3）建立標(biāo)準(zhǔn)模塊：modMyClassFactory
Option Explicit
Private Type tMyObject '這個(gè)object對(duì)象，只占用8字節(jié)，(只有 Variant類型（16字節(jié)）的一半。)
pVTable As Long
RefCount As Long
End Type
'IUnknown的實(shí)現(xiàn)
Public Function QueryInterface(This As tMyObject, ByVal pReqIID As Long, ppObj As stdole.IUnknown) As Long '<- HResult
QueryInterface = &H80004002 'E_NOINTERFACE ...
End Function
Public Function AddRef(This As tMyObject) As Long 'object對(duì)象的引用計(jì)數(shù)
This.RefCount = This.RefCount + 1
AddRef = This.RefCount
End Function
Public Function Release(This As tMyObject) As Long
This.RefCount = This.RefCount - 1
Release = This.RefCount
If This.RefCount = 0 Then CoTaskMemFree VarPtr(This) '當(dāng)引用計(jì)數(shù)為0時(shí)，清除對(duì)象的內(nèi)存
End Function
'IMyClass方法的實(shí)現(xiàn) (IMyClass 在這里只有一個(gè)方法addTwoLongs)
Public Function AddTwoLongs(This As tMyObject, ByVal L1 As Long, ByVal L2 As Long, Result As Long) As Long '<- HResult
Result = L1 + L2 '注意，這里增加的Result參數(shù)是用ByRef -(這個(gè)Result也將被用于傳遞 Error)
End Function
'創(chuàng)建類IMyClass的實(shí)例(a new object)
Public Function CreateInstance() As IMyClass
Dim MyObj As tMyObject
MyObj.pVTable = modMyClassDef.VTablePtr
MyObj.RefCount = 1 '引用計(jì)數(shù)+1
Dim pMem As Long
pMem = CoTaskMemAlloc(LenB(MyObj)) '分配8字節(jié)大小的 Object對(duì)象
Assign ByVal pMem, MyObj, LenB(MyObj)
Assign CreateInstance, pMem
End Function
通過以上的代碼，可以看出來，類都是在標(biāo)準(zhǔn)模塊中建立的而不是在類模塊中建立。
思路就是，建立一個(gè)Vtable的自定義類型，這個(gè)Vtable包含iunknown的三個(gè)方法名稱，同時(shí)也定義類的所有屬性和方法的名稱，然后把模準(zhǔn)模塊中實(shí)現(xiàn)的函數(shù)用AddRessof操作符返回函數(shù)指針分別賦值給Vtable對(duì)應(yīng)的函數(shù)名稱。每個(gè)類都必須自己實(shí)現(xiàn)createInstance方法（相當(dāng)于New)用來初始化類實(shí)例。這個(gè)createInstance方法可以帶參數(shù)，用來實(shí)例化具體的對(duì)象。
（4）如何調(diào)用這個(gè)類呢？
建立一個(gè)Form1的窗體：
Option Explicit
Private Sub Form_Click()
Dim MyObj As IMyClass
Set MyObj = modMyClassFactory.CreateInstance '創(chuàng)建一個(gè)iMyClass的對(duì)象，相當(dāng)于New語句
Caption = "Result = " & MyObj.AddTwoLongs(1, 2) '調(diào)用對(duì)象的AddTwoLongs方法
End Sub
當(dāng)要銷毀對(duì)象時(shí)，也同樣是寫 set MyObj=nothing
輕量級(jí)的com類能夠帶來一些好處：
1、穩(wěn)定的函數(shù)指針（其實(shí)vba的函數(shù)指針有好多種方法，多得讓你有點(diǎn)迷惑）
2、實(shí)例化類的性能成百倍的提升
3、內(nèi)存占用小
4、讓類的繼承成為可能（手工繼承，而不是編譯器級(jí)繼承）
5、前期綁定無須引用類型庫（ocx除外）
……
以后有空余時(shí)間慢慢寫吧
第一種情況：純手工輕量級(jí)Com類
（1）建立標(biāo)準(zhǔn)模塊：modComhelper
Option Explicit
Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&) '分配對(duì)象內(nèi)存的api函數(shù)
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&) '釋放對(duì)象時(shí)清除內(nèi)存
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4) 'copyMemory函數(shù)，這是太有名了。
Function FuncPtr(ByVal Addr As Long) As Long '返回函數(shù)指針，配合addressof使用
FuncPtr = Addr
End Function
（2）建立標(biāo)準(zhǔn)模塊：modMyClassdef
Option Explicit
Private Type tMyCOMcompatibleVTable
'iUnknown接口必須要有三個(gè)方法，這是固定死了。這里定義是這三個(gè)方法的指針（long)
QueryInterface As Long
AddRef As Long
Release As Long
'自定義類的方法、屬性，這里只有一個(gè)addTowLongs函數(shù)，也是一個(gè)指針（long）
AddTwoLongs As Long
End Type
Private mVTable As tMyCOMcompatibleVTable '在棧上（而不是在堆上）預(yù)分配Vtable的內(nèi)存
Public Function VTablePtr() As Long '這是唯一的對(duì)外定義的函數(shù)，用來返回mVtable的首地址 (會(huì)在 modMyClassFactory中調(diào)用)
If mVTable.QueryInterface = 0 Then InitVTable '初始化
VTablePtr = VarPtr(mVTable) 'Vtableptr指針指向mVtable的首地址
End Function
Private Sub InitVTable() '初始化Vtable只能調(diào)用一次
mVTable.QueryInterface = FuncPtr(AddressOf modMyClassFactory.QueryInterface)
mVTable.AddRef = FuncPtr(AddressOf modMyClassFactory.AddRef)
mVTable.Release = FuncPtr(AddressOf modMyClassFactory.Release)
mVTable.AddTwoLongs = FuncPtr(AddressOf modMyClassFactory.AddTwoLongs)
End Sub
（3）建立標(biāo)準(zhǔn)模塊：modMyClassFactory
Option Explicit
Private Type tMyObject '這個(gè)object對(duì)象，只占用8字節(jié)，(只有 Variant類型（16字節(jié)）的一半。)
pVTable As Long
RefCount As Long
End Type
'IUnknown的實(shí)現(xiàn)
Public Function QueryInterface(This As tMyObject, ByVal pReqIID As Long, ppObj As stdole.IUnknown) As Long '<- HResult
QueryInterface = &H80004002 'E_NOINTERFACE ...
End Function
Public Function AddRef(This As tMyObject) As Long 'object對(duì)象的引用計(jì)數(shù)
This.RefCount = This.RefCount + 1
AddRef = This.RefCount
End Function
Public Function Release(This As tMyObject) As Long
This.RefCount = This.RefCount - 1
Release = This.RefCount
If This.RefCount = 0 Then CoTaskMemFree VarPtr(This) '當(dāng)引用計(jì)數(shù)為0時(shí)，清除對(duì)象的內(nèi)存
End Function
'IMyClass方法的實(shí)現(xiàn) (IMyClass 在這里只有一個(gè)方法addTwoLongs)
Public Function AddTwoLongs(This As tMyObject, ByVal L1 As Long, ByVal L2 As Long, Result As Long) As Long '<- HResult
Result = L1 + L2 '注意，這里增加的Result參數(shù)是用ByRef -(這個(gè)Result也將被用于傳遞 Error)
End Function
'創(chuàng)建類IMyClass的實(shí)例(a new object)
Public Function CreateInstance() As IMyClass
Dim MyObj As tMyObject
MyObj.pVTable = modMyClassDef.VTablePtr
MyObj.RefCount = 1 '引用計(jì)數(shù)+1
Dim pMem As Long
pMem = CoTaskMemAlloc(LenB(MyObj)) '分配8字節(jié)大小的 Object對(duì)象
Assign ByVal pMem, MyObj, LenB(MyObj)
Assign CreateInstance, pMem
End Function
通過以上的代碼，可以看出來，類都是在標(biāo)準(zhǔn)模塊中建立的而不是在類模塊中建立。
思路就是，建立一個(gè)Vtable的自定義類型，這個(gè)Vtable包含iunknown的三個(gè)方法名稱，同時(shí)也定義類的所有屬性和方法的名稱，然后把模準(zhǔn)模塊中實(shí)現(xiàn)的函數(shù)用AddRessof操作符返回函數(shù)指針分別賦值給Vtable對(duì)應(yīng)的函數(shù)名稱。每個(gè)類都必須自己實(shí)現(xiàn)createInstance方法（相當(dāng)于New)用來初始化類實(shí)例。這個(gè)createInstance方法可以帶參數(shù)，用來實(shí)例化具體的對(duì)象。
（4）如何調(diào)用這個(gè)類呢？
建立一個(gè)Form1的窗體：
Option Explicit
Private Sub Form_Click()
Dim MyObj As IMyClass
Set MyObj = modMyClassFactory.CreateInstance '創(chuàng)建一個(gè)iMyClass的對(duì)象，相當(dāng)于New語句
Caption = "Result = " & MyObj.AddTwoLongs(1, 2) '調(diào)用對(duì)象的AddTwoLongs方法
End Sub
當(dāng)要銷毀對(duì)象時(shí)，也同樣是寫 set MyObj=nothing
