Results 1 to 4 of 4

Thread: events for late-bound objects (vb6 com events IIDSTR_IConnectionPointContainer)

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    events for late-bound objects (vb6 com events IIDSTR_IConnectionPointContainer)

    how to get args name,args type?
    events for late-bound objects.zip

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: events for late-bound objects (vb6 com events IIDSTR_IConnectionPointContainer)

    Code:
    Option Explicit
    Dim ExcelApp As Object
    Private Sub Command1_Click()
        Set ExcelApp = CreateObject("excel.application")
        Advise ExcelApp
        ExcelApp.Visible = True
        ExcelApp.WorkBooks.Add
    End Sub
    BASE CODE:
    Code:
    Option Explicit
    
    Type CSink
        Interfaces As Long
        RefCount As Long
        EventIID As UUID
    End Type
    
    Private IID_IUnknown As UUID
    Private IID_IDispatch As UUID
    
    Dim vtable(0 To 6) As Long
    
    Private Function EventSink_QueryInterface(This As CSink, RIID As UUID, lObj As Long) As Long
        On Error GoTo ErrLine
        If IsEqualGUID(RIID, IID_IUnknown) Then
            lObj = VarPtr(This)
            This.RefCount = This.RefCount + 1
        ElseIf IsEqualGUID(RIID, IID_IDispatch) Then
            lObj = VarPtr(This)
            This.RefCount = This.RefCount + 1
        ElseIf IsEqualGUID(RIID, This.EventIID) Then
            lObj = VarPtr(This)
            This.RefCount = This.RefCount + 1
        Else
            lObj = 0
            EventSink_QueryInterface = E_NOINTERFACE
        End If
    ErrLine:
    End Function
    
    Private Function EventSink_AddRef(This As CSink) As Long
        This.RefCount = This.RefCount + 1
        EventSink_AddRef = This.RefCount
    End Function
    
    Private Function EventSink_Release(This As CSink) As Long
        This.RefCount = This.RefCount - 1
        EventSink_Release = This.RefCount
        If This.RefCount = 0 Then GlobalFree VarPtr(This)
    End Function
    
    Private Function EventSink_GetTypeInfoCount(This As CSink, pctinfo As Long) As Long
        pctinfo = 0                                                                 ' Not implemented
        EventSink_GetTypeInfoCount = E_NOTIMPL
    End Function
    
    Private Function EventSink_GetTypeInfo(This As CSink, ByVal iTInfo As Long, ByVal lcid As Long, ppTInfo As Long) As Long
        ppTInfo = 0
        EventSink_GetTypeInfo = E_NOTIMPL
    End Function
    
    Private Function EventSink_GetIDsOfNames(This As CSink, RIID As UUID, rgszNames As Long, ByVal cNames As Long, ByVal lcid As Long, rgDispId As Long) As Long
        EventSink_GetIDsOfNames = E_NOTIMPL
    End Function
    
    Private Function EventSink_Invoke(This As CSink, ByVal dispIdMember As Long, RIID As olelib.UUID, ByVal lcid As Long, ByVal wFlags As Integer, ByVal pDispParams As Long, ByVal pVarResult As Long, pExcepInfo As olelib.EXCEPINFO, puArgErr As Long) As Long
        Dim a() As Variant
       
        OnEvent dispIdMember
        EventSink_Invoke = S_OK                                                     ' This method never fails
    End Function
    
    Private Function AddrOf(ByVal Add As Long) As Long
        AddrOf = Add
    End Function
    Private Function OnEvent(ByVal dispIdMember As Long) As Long
        Form1.List1.AddItem "事件ID:" & dispIdMember
    End Function
    Public Function CreateSink(EventIID As UUID) As Object
        Dim lEventSinkPtr As Long, lOldProt As Long
        vtable(0) = AddrOf(AddressOf EventSink_QueryInterface)
        vtable(1) = AddrOf(AddressOf EventSink_AddRef)
        vtable(2) = AddrOf(AddressOf EventSink_Release)
        vtable(3) = AddrOf(AddressOf EventSink_GetTypeInfoCount)
        vtable(4) = AddrOf(AddressOf EventSink_GetTypeInfo)
        vtable(5) = AddrOf(AddressOf EventSink_GetIDsOfNames)
        vtable(6) = AddrOf(AddressOf EventSink_Invoke)
        Dim EventSink As CSink
        With EventSink
            .Interfaces = VarPtr(vtable(0))
            .RefCount = 1
            .EventIID = EventIID
        End With
        lEventSinkPtr = GlobalAlloc(GPTR, LenB(EventSink))
        If lEventSinkPtr Then
            MoveMemory ByVal lEventSinkPtr, EventSink, LenB(EventSink)
            MoveMemory CreateSink, lEventSinkPtr, 4
            CLSIDFromString IIDSTR_IUnknown, IID_IUnknown
            CLSIDFromString IIDSTR_IDispatch, IID_IDispatch
        Else
            Err.Raise 7, "CreateEventSink"
        End If
    End Function
    
    Sub Advise(EventObject As Object, Optional SourceIID As String)
        On Error GoTo ErrLine
        Dim oCPC As IConnectionPointContainer
        Dim oEnm As IEnumConnectionPoints
        Dim oCP As IConnectionPoint
        Dim oUnk As olelib.IUnknown
        Dim tIID As UUID
        Dim lCookie As Long
        Set oCPC = EventObject
        If LenB(SourceIID) = 0 Then
            Set oEnm = oCPC.EnumConnectionPoints
            oEnm.Next 1, oCP
            oCP.GetConnectionInterface tIID
        Else
            CLSIDFromString SourceIID, tIID
            Set oCP = oCPC.FindConnectionPoint(tIID)
        End If
        Set oUnk = CreateSink(tIID)
        lCookie = oCP.Advise(oUnk)
        Exit Sub
    Disconnect:
        oCP.Unadvise lCookie
    ErrLine:
    End Sub

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: events for late-bound objects (vb6 com events IIDSTR_IConnectionPointContainer)

    what about this?
    COM: Handle Late-bound Events within Visual Basic Using an ATL Bridge | Microsoft Docs
    https://docs.microsoft.com/en-us/arc...-an-atl-bridge

    Using ActiveX Controls with PB7 including EVENTS - PowerBASIC Peer Support Community
    https://forum.powerbasic.com/forum/u...cluding-events

    COMSRV.DLL
    COMBRIDGELib.combridgecls
    Dim WithEvents bridgeobj As COMBRIDGELib.combridgecls
    Dim eventobj As comevent.comeventcls
    Dim serverobj As Object

    Set bridgeobj = New COMBRIDGELib.combridgecls

    Set eventobj = New comevent.comeventcls
    Set serverobj = CreateObject(txtServerProgID.Text)
    bridgeobj.startmonitoring serverobj, eventobj



    Private Sub bridgeobj_incomingevent (eventobj As Object)
    '
    end sub
    Last edited by xiaoyao; Feb 16th, 2021 at 02:28 PM.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: events for late-bound objects (vb6 com events IIDSTR_IConnectionPointContainer)

    Did anyone run the test?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width