' COM event sink pattern with IConnectionPoint via DECLARE
#COMPILE EXE
#DIM ALL

DECLARE FUNCTION CoInitialize LIB "OLE32.DLL" (BYVAL pvReserved AS LONG) AS LONG
DECLARE FUNCTION CoUninitialize LIB "OLE32.DLL" () AS LONG
DECLARE FUNCTION CoCreateInstance LIB "OLE32.DLL" (BYREF rclsid As Byte, BYVAL pUnkOuter AS LONG, BYVAL dwClsContext AS LONG, BYREF riid As Byte, BYREF ppv AS LONG) AS LONG

%S_OK = 0
%E_NOINTERFACE = &H80004002
%CONNECT_E_CANNOTCONNECT = &H80040202

TYPE EventSink
    cookie AS LONG
    connected AS LONG
    sourceObj AS LONG
END TYPE

TYPE EventCallback
    eventName AS STRING
    dispID AS LONG
    fired AS LONG
END TYPE

SUB InitSink(BYREF sink AS EventSink)
    sink.cookie = 0
    sink.connected = 0
    sink.sourceObj = 0
END SUB

FUNCTION ConnectSink(BYREF sink AS EventSink, BYVAL sourceObj AS LONG, BYVAL sinkUnk AS LONG) AS LONG
    PRINT "Connecting event sink..."
    LOCAL hr AS LONG
    sink.sourceObj = sourceObj
    sink.cookie = 12345
    sink.connected = 1
    PRINT "  Connection established. Cookie: "; sink.cookie
    FUNCTION = %S_OK
END FUNCTION

FUNCTION DisconnectSink(BYREF sink AS EventSink) AS LONG
    IF sink.connected = 0 THEN
        PRINT "  Not connected"
        FUNCTION = %S_OK
    END IF
    PRINT "  Disconnecting sink (cookie "; sink.cookie; ")"
    sink.cookie = 0
    sink.connected = 0
    sink.sourceObj = 0
    FUNCTION = %S_OK
END FUNCTION

FUNCTION SinkCallback(BYREF cb AS EventCallback, BYVAL eventName AS STRING, BYVAL dispID AS LONG) AS LONG
    cb.eventName = eventName
    cb.dispID = dispID
    cb.fired = cb.fired + 1
    PRINT "  Event fired: "; eventName; " (dispID="; dispID; ")"
    PRINT "  Total fires: "; cb.fired
    FUNCTION = %S_OK
END FUNCTION

SUB SimpleEventSinkDemo()
    PRINT "COM Event Sink pattern:"
    PRINT ""
    LOCAL sink AS EventSink
    InitSink(sink)
    LOCAL sourceObj AS LONG
    sourceObj = &H123456
    ConnectSink(sink, sourceObj, 0)
    PRINT ""
    LOCAL cb AS EventCallback
    SinkCallback(cb, "OnClick", 100)
    SinkCallback(cb, "OnChange", 101)
    SinkCallback(cb, "OnClose", 102)
    PRINT ""
    DisconnectSink(sink)
END SUB

SUB ConnectionPointDemo()
    PRINT ""
    PRINT "IConnectionPoint sequence:"
    PRINT "  1. QueryInterface(source, IID_IConnectionPointContainer)"
    PRINT "  2. FindConnectionPoint(IID_MyEvents) -> cp"
    PRINT "  3. Advise(cp, sinkUnk, &cookie)"
    PRINT "  4. Source fires events -> sink receives"
    PRINT "  5. Unadvise(cp, cookie)"
    PRINT "  6. Release all interfaces"
END SUB

SUB EventPropagationDemo()
    PRINT ""
    PRINT "Multi-handler event propagation:"
    LOCAL handlers(0:2) AS LONG
    handlers(0) = 10
    handlers(1) = 20
    handlers(2) = 30
    LOCAL i AS LONG
    FOR i = 0 TO 2
        PRINT "  Notifying handler "; handlers(i)
    NEXT i
END SUB

SUB ErrorHandlingDemo()
    PRINT ""
    PRINT "COM error handling:"
    DIM results(0:3) AS LONG
    DIM descs(0:3) AS STRING
    results(0) = %S_OK: descs(0) = "Success"
    results(1) = %E_NOINTERFACE: descs(1) = "Interface not supported"
    results(2) = %CONNECT_E_CANNOTCONNECT: descs(2) = "Cannot connect"
    results(3) = %S_OK: descs(3) = "Advise successful"
    LOCAL i AS LONG
    FOR i = 0 TO 3
        PRINT "  Result: "; results(i); " -> "; descs(i)
    NEXT i
END SUB

FUNCTION PBMAIN() AS LONG
    PRINT "=== COM Event Sink Demo ==="
    PRINT "IConnectionPoint, Advise/Unadvise via DECLARE"
    SimpleEventSinkDemo()
    ConnectionPointDemo()
    EventPropagationDemo()
    ErrorHandlingDemo()
    PRINT "=== End COM Event Sink ==="
    FUNCTION = 0
END FUNCTION
