[1678] | 1 | { **************************************************************
|
---|
| 2 | Package: XWB - Kernel RPCBroker
|
---|
| 3 | Date Created: Sept 18, 1997 (Version 1.1)
|
---|
| 4 | Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
|
---|
| 5 | Developers: Kevin Meldrum, Travis Hilton, Joel Ivey
|
---|
| 6 | Description: Provides Event Sink for
|
---|
| 7 | RPCSharedBrokerSessionMgr1.
|
---|
| 8 | Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
|
---|
| 9 | *************************************************************** }
|
---|
| 10 |
|
---|
| 11 | unit SharedRPCBrokerSink;
|
---|
| 12 |
|
---|
| 13 | interface
|
---|
| 14 | uses
|
---|
| 15 | ComObj, SharedRPCBroker;
|
---|
| 16 |
|
---|
| 17 | type
|
---|
| 18 | TSharedRPCBrokerSink = class(TInterfacedObject, IUnknown, IDispatch)
|
---|
| 19 | private
|
---|
| 20 | FBroker: TSharedRPCBroker;
|
---|
| 21 | public
|
---|
| 22 | //IUnknown
|
---|
| 23 | //Method resolution clause to allow QueryInterface to be redefined
|
---|
| 24 | function IUnknown.QueryInterface = QueryInterface;
|
---|
| 25 | function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
---|
| 26 | //IDispatch
|
---|
| 27 | function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
|
---|
| 28 | function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
|
---|
| 29 | function GetIDsOfNames(const IID: TGUID; Names: Pointer;
|
---|
| 30 | NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
|
---|
| 31 | function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
|
---|
| 32 | Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
|
---|
| 33 | public
|
---|
| 34 | property Broker: TSharedRPCBroker read FBroker write FBroker;
|
---|
| 35 | end;
|
---|
| 36 |
|
---|
| 37 | implementation
|
---|
| 38 |
|
---|
| 39 | uses
|
---|
| 40 | Windows, ActiveX, RPCSharedBrokerSessionMgr1_TLB_SRB;
|
---|
| 41 |
|
---|
| 42 | function TSharedRPCBrokerSink.QueryInterface(const IID: TGUID; out Obj): HResult;
|
---|
| 43 | begin
|
---|
| 44 | Result := E_NOINTERFACE;
|
---|
| 45 | //If events interface requested, return IDispatch
|
---|
| 46 | if IsEqualIID(IID, DIID_ISharedBrokerEvents) then
|
---|
| 47 | begin
|
---|
| 48 | if GetInterface(IDispatch, Obj) then
|
---|
| 49 | Result := S_OK
|
---|
| 50 | end
|
---|
| 51 | else
|
---|
| 52 | //Handle other interface requests normally
|
---|
| 53 |
|
---|
| 54 | if GetInterface(IID, Obj) then
|
---|
| 55 | Result := S_OK
|
---|
| 56 | end;
|
---|
| 57 |
|
---|
| 58 | function TSharedRPCBrokerSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
|
---|
| 59 | NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
|
---|
| 60 | begin
|
---|
| 61 | Result := E_NOTIMPL
|
---|
| 62 | end;
|
---|
| 63 |
|
---|
| 64 | function TSharedRPCBrokerSink.GetTypeInfo(Index, LocaleID: Integer;
|
---|
| 65 | out TypeInfo): HResult;
|
---|
| 66 | begin
|
---|
| 67 | Result := E_NOTIMPL
|
---|
| 68 | end;
|
---|
| 69 |
|
---|
| 70 | function TSharedRPCBrokerSink.GetTypeInfoCount(out Count: Integer): HResult;
|
---|
| 71 | begin
|
---|
| 72 | Count := 0;
|
---|
| 73 | Result := S_OK
|
---|
| 74 | end;
|
---|
| 75 |
|
---|
| 76 | function TSharedRPCBrokerSink.Invoke(DispID: Integer; const IID: TGUID;
|
---|
| 77 | LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
|
---|
| 78 | ArgErr: Pointer): HResult;
|
---|
| 79 | var
|
---|
| 80 | Args: PVariantArgList;
|
---|
| 81 | ASharedBroker: ISharedBroker;
|
---|
| 82 | ConnectionIndex: Integer;
|
---|
| 83 | ErrorText: WideString;
|
---|
| 84 | // UniqueClientID: Integer;
|
---|
| 85 | // BrokerConnectionType: ISharedBrokerConnection;
|
---|
| 86 | begin
|
---|
| 87 | Result := S_OK;
|
---|
| 88 | ConnectionIndex := 0;
|
---|
| 89 | // UniqueClientID := -1;
|
---|
| 90 |
|
---|
| 91 | //This is called to trigger an event interface method, if implemented
|
---|
| 92 | //We need to check which one it is (by DispID) and do something sensible if we
|
---|
| 93 | //support the triggered event
|
---|
| 94 |
|
---|
| 95 | //Both event methods happen to have the same parameters,
|
---|
| 96 | //so we can extract them just once to save duplication
|
---|
| 97 | Args := TDispParams(Params).rgvarg;
|
---|
| 98 | //Params are in reverse order:
|
---|
| 99 | //Last parameter is at pos. 0
|
---|
| 100 | //First parameter is at pos. cArgs - 1
|
---|
| 101 | If DispID = 1 then
|
---|
| 102 | ASharedBroker := IUnknown(OleVariant(Args^[0])) as ISharedBroker;
|
---|
| 103 | If DispID = 3 then
|
---|
| 104 | begin
|
---|
| 105 | // UniqueClientID := OleVariant(Args^[1]);
|
---|
| 106 | // BrokerConnectionType := OleVariant(Args^[0]);
|
---|
| 107 | end;
|
---|
| 108 | if DispID = 4 then
|
---|
| 109 | begin
|
---|
| 110 | // UniqueClientID := OleVariant(Args^[0]);
|
---|
| 111 | end;
|
---|
| 112 | If DispId = 8 then
|
---|
| 113 | begin
|
---|
| 114 | ConnectionIndex := OleVariant(Args^[1]);
|
---|
| 115 | ErrorText := OleVariant(Args^[0]);
|
---|
| 116 | end;
|
---|
| 117 | //This is called to trigger an event interface method, if implemented
|
---|
| 118 | //We need to check which one it is (by DispID) and do something sensible if we
|
---|
| 119 | //support the triggered event
|
---|
| 120 | case DispID of
|
---|
| 121 | 1: if Assigned(FBroker.OnLogout) then
|
---|
| 122 | FBroker.OnLogout;
|
---|
| 123 | {
|
---|
| 124 | 3: if Assigned(FBroker.OnClientConnected) then
|
---|
| 125 | FBroker.OnClientConnected(UniqueClientID);
|
---|
| 126 | 4: if Assigned(FBroker.OnClientDisconnected) then
|
---|
| 127 | FBroker.OnClientDisconnected(UniqueClientID);
|
---|
| 128 | }
|
---|
| 129 | 8: if Assigned(FBroker.OnConnectionDropped) then
|
---|
| 130 | FBroker.OnConnectionDropped(ConnectionIndex, ErrorText);
|
---|
| 131 | else
|
---|
| 132 | //Ignore other events
|
---|
| 133 | end
|
---|
| 134 | end;
|
---|
| 135 |
|
---|
| 136 | end.
|
---|