source: cprs/branches/GUI-config/BDK32/Source/SharedRPCBrokerSink.pas@ 1536

Last change on this file since 1536 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 4.4 KB
RevLine 
[476]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
11unit SharedRPCBrokerSink;
12
13interface
14uses
15 ComObj, SharedRPCBroker;
16
17type
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
37implementation
38
39uses
40 Windows, ActiveX, RPCSharedBrokerSessionMgr1_TLB_SRB;
41
42function TSharedRPCBrokerSink.QueryInterface(const IID: TGUID; out Obj): HResult;
43begin
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
56end;
57
58function TSharedRPCBrokerSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
59 NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
60begin
61 Result := E_NOTIMPL
62end;
63
64function TSharedRPCBrokerSink.GetTypeInfo(Index, LocaleID: Integer;
65 out TypeInfo): HResult;
66begin
67 Result := E_NOTIMPL
68end;
69
70function TSharedRPCBrokerSink.GetTypeInfoCount(out Count: Integer): HResult;
71begin
72 Count := 0;
73 Result := S_OK
74end;
75
76function TSharedRPCBrokerSink.Invoke(DispID: Integer; const IID: TGUID;
77 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
78 ArgErr: Pointer): HResult;
79var
80 Args: PVariantArgList;
81 ASharedBroker: ISharedBroker;
82 ConnectionIndex: Integer;
83 ErrorText: WideString;
84// UniqueClientID: Integer;
85// BrokerConnectionType: ISharedBrokerConnection;
86begin
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
134end;
135
136end.
Note: See TracBrowser for help on using the repository browser.