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 FunctionFunction 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文件复制该常量或放在生成目录下编译完活。