| [829] | 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 40 (January 7, 2005)) | 
|---|
|  | 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. | 
|---|