Vfb调用Stdcall、cdcel、COM组件

[驰骋乾坤]

发个Vfb调用Stdcall、cdcel、COM组件的例子
Stdcall、cdcel的dll调用so easy就不说了，来个COM组件的例子
1、vb6创建一个dll工程，修改类名为EventClass
类里写入以下代码：
Public Event OnEvent()
Public Event OnOtherEvent()
Public Sub DoRaiseEvent()
RaiseEvent OnEvent
MsgBox "测试事件1"
End Sub
Public Sub DoOtherRaiseEvent()
RaiseEvent OnOtherEvent
MsgBox "测试事件2"
End Sub
2、创建一个Vfb工程添加以下代码：
公共区：
Type ExcelSink Extends Object
Declare Virtual Function QueryInterface (ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
Declare Virtual Function AddRef() As ULong
Declare Virtual Function Release() As ULong
Declare Virtual Function GetTypeInfoCount(ByVal pctinfo As UINT Ptr) As HRESULT
Declare Virtual Function GetTypeInfo(ByVal iTInfo As UINT, ByVal lcid As LCID, ByVal ppTInfo As ITypeInfo Ptr Ptr) As HRESULT
Declare Virtual Function GetIDsOfNames(ByVal riid As Const IID Const Ptr, ByVal rgszNames As LPOLESTR Ptr, ByVal cNames As UINT, ByVal lcid As LCID, ByVal rgDispId As DISPID Ptr) As HRESULT
Declare Virtual Function Invoke(ByVal dispIdMember As DISPID, ByVal riid As Const IID Const Ptr, ByVal lcid As LCID, ByVal wFlags As WORD, ByVal pDispParams As DISPPARAMS Ptr, ByVal pVarResult As VARIANT Ptr, ByVal pExcepInfo As EXCEPINFO Ptr, ByVal puArgErr As UINT Ptr) As HRESULT
cRef As ULong
End Type
Function ExcelSink.QueryInterface(ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
*ppvObject = @this
Function =S_OK
End Function
Function ExcelSink.AddRef() As ULong
This.cRef += 1
Function = This.cRef
End Function
Function ExcelSink.Release() As ULong
This.cRef -= 1
Function = This.cRef
End Function
Function ExcelSink.GetTypeInfoCount(ByVal pctinfo As UINT Ptr) As HRESULT
*pctInfo = 0
Return E_NOTIMPL
End Function
Function ExcelSink.GetTypeInfo(ByVal iTInfo As UINT, ByVal lcid As LCID, ByVal ppTInfo As ITypeInfo Ptr Ptr) As HRESULT
Return E_NOTIMPL
End Function
Function ExcelSink.GetIDsOfNames(ByVal riid As Const IID Const Ptr, ByVal rgszNames As LPOLESTR Ptr, ByVal cNames As UINT, ByVal lcid As LCID, ByVal rgDispId As DISPID Ptr) As HRESULT
Return E_NOTIMPL
End Function
Function ExcelSink.Invoke(ByVal dispIdMember As DISPID, ByVal riid As Const IID Const Ptr, ByVal lcid As LCID, ByVal wFlags As WORD, ByVal pDispParams As DISPPARAMS Ptr, ByVal pVarResult As VARIANT Ptr, ByVal pExcepInfo As EXCEPINFO Ptr, ByVal puArgErr As UINT Ptr) As HRESULT
Select Case dispIdMember
Case 1
MessageBox(0, "我的事件1", "", 0)
Case 2
MessageBox(0, "我的事件2", "", 0)
End Select
Function = 0
End Function

Function Advise(ByVal MeObj As IDispatch Ptr, ByVal pEvtObj As IDispatch Ptr, ByVal m_riidEvt As IID Ptr) As HRESULT
If pEvtObj = Null Then Return E_POINTER
Dim pCPC As IConnectionPointContainer Ptr
Dim hr As HRESULT = IUnknown_QueryInterface(MeObj, @IID_IConnectionPointContainer, @pCPC)
If hr <> S_OK Or pCPC = Null Then
Return hr
End If
Dim pCP As IConnectionPoint Ptr
hr = pCPC->lpvtbl->FindConnectionPoint(pCPC, m_riidEvt, @pCP)
If hr <> S_OK Or pCP = Null Then
AfxSafeRelease(pCPC)
Return hr
End If
Dim m_dwCookie As DWord
If m_dwCookie Then hr = pCP->lpvtbl->Unadvise(pCP, m_dwCookie)
m_dwCookie = 0
hr = pCP->lpvtbl->Advise(pCP, Cast(IUnknown Ptr, pEvtObj), @m_dwCookie)
If hr <> S_OK Then MessageBox(0, "8", "", 0)
AfxSafeRelease(pCPC)
AfxSafeRelease(pCP)
Return hr
End Function

调用区：（按钮事件）

Dim pAxHost As CAxHost Ptr
Dim AppPtr As IDispatch Ptr = pAxHost->CreateObject("test.EventClass")
Dim pDisp As CDispInvoke = AppPtr
If pDisp.DispPtr = Null Then MessageBox(0, "AppPtr出问题了", "测试", 0)
Dim MySink As ExcelSink
Dim pSink As IDispatch Ptr
MySink.QueryInterface(@IID_IDispatch, @pSink)
Const AFX_IID___EventClass = "{B73195A6-8732-44A2-BC0F-1E6E1D6AE3E8}"
Dim EventIID As clsid
CLSIDFromString(AFX_IID___EventClass, @EventIID)
Advise(pDisp.DispPtr, pSink, @EventIID)
pDisp.Invoke("DoRaiseEvent")
pDisp.Invoke("DoOtherRaiseEvent")

3、其中AFX_IID___EventClass需要查注册表事件接口的IID
'[
' uuid(B73195A6-8732-44A2-BC0F-1E6E1D6AE3E8),
' version(1.0),
' hidden,
' nonextensible
']
'dispinterface __EventClass {
' properties:
' methods:
' [id(0x00000001)]
' void OnEvent();
' [id(0x00000002)]
' void OnOtherEvent();
'};
中的UUID或使用vfb自带的工具“COM类型库查看器”
生成bi文件复制该常量或放在生成目录下编译完活。

[驰骋乾坤]

事件UUID用vfb自带的工具“COM类型库查看器”生成bi文件后，直接放在exe生成目录下，编译即可！