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