日志
轻量级lightweight的com类
热度 4 |
我在邪门武器之四中曾经谈过轻量级的com类，其实这是一个非常长的话题。
轻量级的com类能够带来一些好处：
1、稳定的函数指针（其实vba的函数指针有好多种方法，多得让你有点迷惑）
2、实例化类的性能成百倍的提升
3、内存占用小
4、让类的继承成为可能（手工继承，而不是编译器级继承）
5、前期绑定无须引用类型库（ocx除外）
……
以后有空余时间慢慢写吧
第一种情况：纯手工轻量级Com类
（1）建立标准模块：modComhelper
Option Explicit
Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&) '分配对象内存的api函数
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&) '释放对象时清除内存
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4) 'copyMemory函数，这是太有名了。
Function FuncPtr(ByVal Addr As Long) As Long '返回函数指针，配合addressof使用
FuncPtr = Addr
End Function
（2）建立标准模块：modMyClassdef
Option Explicit
Private Type tMyCOMcompatibleVTable
'iUnknown接口必须要有三个方法，这是固定死了。这里定义是这三个方法的指针（long)
QueryInterface As Long
AddRef As Long
Release As Long
'自定义类的方法、属性，这里只有一个addTowLongs函数，也是一个指针（long）
AddTwoLongs As Long
End Type
Private mVTable As tMyCOMcompatibleVTable '在栈上（而不是在堆上）预分配Vtable的内存
Public Function VTablePtr() As Long '这是唯一的对外定义的函数，用来返回mVtable的首地址 (会在 modMyClassFactory中调用)
If mVTable.QueryInterface = 0 Then InitVTable '初始化
VTablePtr = VarPtr(mVTable) 'Vtableptr指针指向mVtable的首地址
End Function
Private Sub InitVTable() '初始化Vtable只能调用一次
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）建立标准模块：modMyClassFactory
Option Explicit
Private Type tMyObject '这个object对象，只占用8字节，(只有 Variant类型（16字节）的一半。)
pVTable As Long
RefCount As Long
End Type
'IUnknown的实现
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对象的引用计数
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) '当引用计数为0时，清除对象的内存
End Function
'IMyClass方法的实现 (IMyClass 在这里只有一个方法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参数是用ByRef -(这个Result也将被用于传递 Error)
End Function
'创建类IMyClass的实例(a new object)
Public Function CreateInstance() As IMyClass
Dim MyObj As tMyObject
MyObj.pVTable = modMyClassDef.VTablePtr
MyObj.RefCount = 1 '引用计数+1
Dim pMem As Long
pMem = CoTaskMemAlloc(LenB(MyObj)) '分配8字节大小的 Object对象
Assign ByVal pMem, MyObj, LenB(MyObj)
Assign CreateInstance, pMem
End Function
通过以上的代码，可以看出来，类都是在标准模块中建立的而不是在类模块中建立。
思路就是，建立一个Vtable的自定义类型，这个Vtable包含iunknown的三个方法名称，同时也定义类的所有属性和方法的名称，然后把模准模块中实现的函数用AddRessof操作符返回函数指针分别赋值给Vtable对应的函数名称。每个类都必须自己实现createInstance方法（相当于New)用来初始化类实例。这个createInstance方法可以带参数，用来实例化具体的对象。
（4）如何调用这个类呢？
建立一个Form1的窗体：
Option Explicit
Private Sub Form_Click()
Dim MyObj As IMyClass
Set MyObj = modMyClassFactory.CreateInstance '创建一个iMyClass的对象，相当于New语句
Caption = "Result = " & MyObj.AddTwoLongs(1, 2) '调用对象的AddTwoLongs方法
End Sub
当要销毁对象时，也同样是写 set MyObj=nothing
轻量级的com类能够带来一些好处：
1、稳定的函数指针（其实vba的函数指针有好多种方法，多得让你有点迷惑）
2、实例化类的性能成百倍的提升
3、内存占用小
4、让类的继承成为可能（手工继承，而不是编译器级继承）
5、前期绑定无须引用类型库（ocx除外）
……
以后有空余时间慢慢写吧
第一种情况：纯手工轻量级Com类
（1）建立标准模块：modComhelper
Option Explicit
Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&) '分配对象内存的api函数
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&) '释放对象时清除内存
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4) 'copyMemory函数，这是太有名了。
Function FuncPtr(ByVal Addr As Long) As Long '返回函数指针，配合addressof使用
FuncPtr = Addr
End Function
（2）建立标准模块：modMyClassdef
Option Explicit
Private Type tMyCOMcompatibleVTable
'iUnknown接口必须要有三个方法，这是固定死了。这里定义是这三个方法的指针（long)
QueryInterface As Long
AddRef As Long
Release As Long
'自定义类的方法、属性，这里只有一个addTowLongs函数，也是一个指针（long）
AddTwoLongs As Long
End Type
Private mVTable As tMyCOMcompatibleVTable '在栈上（而不是在堆上）预分配Vtable的内存
Public Function VTablePtr() As Long '这是唯一的对外定义的函数，用来返回mVtable的首地址 (会在 modMyClassFactory中调用)
If mVTable.QueryInterface = 0 Then InitVTable '初始化
VTablePtr = VarPtr(mVTable) 'Vtableptr指针指向mVtable的首地址
End Function
Private Sub InitVTable() '初始化Vtable只能调用一次
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）建立标准模块：modMyClassFactory
Option Explicit
Private Type tMyObject '这个object对象，只占用8字节，(只有 Variant类型（16字节）的一半。)
pVTable As Long
RefCount As Long
End Type
'IUnknown的实现
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对象的引用计数
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) '当引用计数为0时，清除对象的内存
End Function
'IMyClass方法的实现 (IMyClass 在这里只有一个方法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参数是用ByRef -(这个Result也将被用于传递 Error)
End Function
'创建类IMyClass的实例(a new object)
Public Function CreateInstance() As IMyClass
Dim MyObj As tMyObject
MyObj.pVTable = modMyClassDef.VTablePtr
MyObj.RefCount = 1 '引用计数+1
Dim pMem As Long
pMem = CoTaskMemAlloc(LenB(MyObj)) '分配8字节大小的 Object对象
Assign ByVal pMem, MyObj, LenB(MyObj)
Assign CreateInstance, pMem
End Function
通过以上的代码，可以看出来，类都是在标准模块中建立的而不是在类模块中建立。
思路就是，建立一个Vtable的自定义类型，这个Vtable包含iunknown的三个方法名称，同时也定义类的所有属性和方法的名称，然后把模准模块中实现的函数用AddRessof操作符返回函数指针分别赋值给Vtable对应的函数名称。每个类都必须自己实现createInstance方法（相当于New)用来初始化类实例。这个createInstance方法可以带参数，用来实例化具体的对象。
（4）如何调用这个类呢？
建立一个Form1的窗体：
Option Explicit
Private Sub Form_Click()
Dim MyObj As IMyClass
Set MyObj = modMyClassFactory.CreateInstance '创建一个iMyClass的对象，相当于New语句
Caption = "Result = " & MyObj.AddTwoLongs(1, 2) '调用对象的AddTwoLongs方法
End Sub
当要销毁对象时，也同样是写 set MyObj=nothing
