| 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. | 
|---|