source: cprs/branches/GUI-config/BDK32/Source/uSharedBroker1.pas@ 881

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

New WorldVistA Config Utility
File size: 66.9 KB
Line 
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: SharedBroker functionality for the
7 RPCSharedBrokerSessionMgr1.
8 Current Release: Version 1.1 Patch 40 (January 7, 2005))
9*************************************************************** }
10
11unit uSharedBroker1;
12
13interface
14
15uses
16 Windows, ComObj, ActiveX, AxCtrls, Classes, RPCSharedBrokerSessionMgr1_TLB, StdVcl,
17 Trpcb;
18
19const
20 kMilliSecondScale: double = 1000;
21 kCloseAllClientsWaitTimeDefault: double = 10 * 1000; // In milliseconds
22 kMillisecondTicksPerSecond: Extended = 1000;
23
24type
25 // RPCCallHistoryEntry contains the call name, params, results and other
26 // info regarding a single rpc call. It is using in passing rpc info
27 // around the history
28 RPCCallHistoryEntry = class
29 private
30 FBrokerContext: WideString; // Context in which the RPC call was made
31 FRpcName: WideString; // M name of the RPC call
32 FParams: WideString; // M parameters to the RPC call
33 FResults: WideString; // results of the call
34 FStartDateTime: Double; // time/date just before the call was made
35 FDurationInMS: Longword; // duration of the RPC in milliseconds
36 FUniqueRPCCallId: Longword; // Unique RPC call id
37 FUniqueClientId: Integer; // The client that made the RPC
38
39 public
40 constructor Create; overload;
41 constructor Create(context:WideString;
42 name:WideString;
43 params:WideString;
44 results:WideString;
45 startDateTime:Double;
46 durationInMS:Longword;
47 clientId:Integer); overload;
48
49 property CallContext:WideString read FBrokerContext write FBrokerContext;
50 property CallName:WideString read FRpcName write FRpcName;
51 property CallParams:WideString read FParams write FParams;
52 property CallResults:WideString read FResults write FResults;
53 property CallStartDateTime:Double read FStartDateTime write FStartDateTime;
54 property CallDurationInMS:Longword read FDurationInMS write FDurationInMS;
55 property UniqueRPCCallId:longword read FUniqueRPCCallId write FUniqueRPCCallId;
56 property BrokerUniqueClientId:Integer read FUniqueClientId write FUniqueClientId;
57 end;
58
59 RPCCallHistoryEntryPointer = ^RPCCallHistoryEntry;
60
61 // RPCCallHistory keeps track of RPCs and their Results. The end data/time and
62 // duration of the call in milliseconds is recorded. The uniqueRPCId of the
63 // call is recorded as well.
64 RPCCallHistory = class(TList)
65 constructor Create; overload;
66 private
67 FEnabled: boolean;
68
69 public
70 function Add(entry: RPCCallHistoryEntry): Integer; reintroduce; overload;
71 property Enabled: boolean read FEnabled write FEnabled;
72 function GetRPCCallEntryPtr(uniqueRpcId:Longword;
73 out rpcEntryPtr:RPCCallHistoryEntryPointer)
74 : ISharedBrokerErrorCode;
75 function GetRPCCallEntryPtrFromIndex(rpcCallIndex:Integer;
76 out rpcEntryPtr:RPCCallHistoryEntryPointer)
77 : ISharedBrokerErrorCode;
78 function GetRPCCallClientId(uniqueRpcId:Integer;
79 out uniqueClientId:Integer)
80 : ISharedBrokerErrorCode;
81 end;
82
83 // Every TSharedBroker contains a reference to a TBrokerConnection.
84 // The TBrokerConnection contains an actual instance to to a TRPCBroker
85 // This is where the connection sharing takes place
86 TBrokerConnection = class
87 private
88 FBroker: TRPCBroker;
89 FShared: Boolean;
90 FServerIP: string;
91 FServer: string;
92 FPort: Integer;
93 FRefCount: Integer;
94 FLastContext: WideString;
95 FConnectionIndex: Integer;
96 end;
97
98 TSharedBroker = class(TAutoObject, IConnectionPointContainer, ISharedBroker)
99 private
100 { Private declarations }
101 FConnectionPoints: TConnectionPoints;
102// FConnectionPoint: TConnectionPoint;
103// FSinkList: TList;
104 FEvents: ISharedBrokerEvents;
105
106 FBrokerConnection: TBrokerConnection;
107 FBrokerContext: WideString;
108 FClientName: WideString;
109 FUniqueClientId: Longword;
110 FRpcCallHistory: RPCCallHistory;
111 FConnectType: ISharedBrokerClient;
112 FInGeneralClientList: Boolean;
113// FShowErrorMsgs: ISharedBrokerShowErrorMsgs;
114
115 procedure DoDisconnect;
116
117 public
118 Destructor Destroy; override;
119 procedure Initialize; override;
120 function GetEnumerator: IEnumConnections;
121 function GetConnectionIndex: Integer;
122 public
123 { Protected declarations }
124 property ConnectionPoints: TConnectionPoints read FConnectionPoints
125 implements IConnectionPointContainer;
126 procedure EventSinkChanged(const EventSink: IUnknown); override;
127 function BrokerConnect(const ClientName: WideString;
128 ConnectionType: ISharedBrokerClient; const ServerPort: WideString;
129 WantDebug, AllowShared, KernelLoginVal: WordBool;
130 ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
131 var LoginStr: WideString; out UniqueClientIId: SYSINT;
132 out ErrorMsg: WideString): ISharedBrokerErrorCode; safecall;
133 function BrokerCall(const RpcName, RpcParams: WideString;
134 RpcTimeLimit: Integer; out RpcResults: WideString;
135 out UniqueRpcCallId: Integer): ISharedBrokerErrorCode; safecall;
136 function BrokerDisconnect: ISharedBrokerErrorCode; safecall;
137 function BrokerSetContext(
138 const OptionName: WideString): ISharedBrokerErrorCode; safecall;
139 function ReadRegDataDefault(Root: IRegistryRootEnum; const Key, Name,
140 Default: WideString;
141 out RegResult: WideString): ISharedBrokerErrorCode; safecall;
142 function Get_PerClientRpcHistoryLimit: Integer; safecall;
143 function Get_RpcHistoryEnabled: WordBool; safecall;
144 function Get_RpcVersion: WideString; safecall;
145 procedure Set_PerClientRpcHistoryLimit(limit: Integer); safecall;
146 procedure Set_RpcHistoryEnabled(enabled: WordBool); safecall;
147 procedure Set_RpcVersion(const version: WideString); safecall;
148 function GetActiveBrokerConnectionIndexCount(
149 out connectionIndexCount: Integer): ISharedBrokerErrorCode; safecall;
150 function GetActiveBrokerConnectionIndexFromUniqueClientId(
151 uniqueClientId: Integer;
152 out connectionIndex: Integer): ISharedBrokerErrorCode; safecall;
153 function GetActiveBrokerConnectionInfo(connectionIndex: Integer;
154 out connectedServerIp: WideString; out connectedServerPort: Integer;
155 out lastContext: WideString): ISharedBrokerErrorCode; safecall;
156 function GetClientIdAndNameFromIndex(clientIndex: Integer;
157 out uniqueClientId: Integer;
158 out clientName: WideString): ISharedBrokerErrorCode; safecall;
159 function GetClientNameFromUniqueClientId(uniqueClientId: Integer;
160 out clientName: WideString): ISharedBrokerErrorCode; safecall;
161 function GetRpcHistoryCountForClient(uniqueClientId: Integer;
162 out rpcHistoryCount: Integer): ISharedBrokerErrorCode; safecall;
163 function LogoutConnectedClients(
164 logoutTimeLimit: Integer): ISharedBrokerErrorCode; safecall;
165 function GetRpcCallFromHistoryIndex(uniqueClientId, rpcCallIndex: Integer;
166 out uniqueRpcId: Integer; out brokerContext, rpcName, rpcParams,
167 rpcResult: WideString; out rpcStartDateTime: Double;
168 out rpcDuration: Integer): ISharedBrokerErrorCode; safecall;
169 function GetRpcClientIdFromHistory(uniqueRpcId: Integer;
170 out uniqueClientId: Integer;
171 out clientName: WideString): ISharedBrokerErrorCode; safecall;
172 function GetConnectedClientCount(
173 out connectedClientCount: Integer): ISharedBrokerErrorCode; safecall;
174 function GetRpcCallFromHistory(uniqueRpcId: Integer;
175 out uniqueClientId: Integer; out brokerContext, rpcName, rpcParams,
176 rpcResult: WideString; out rpcStartDateTime: Double;
177 out rpcDuration: Integer): ISharedBrokerErrorCode; safecall;
178 function Get_CurrentContext: WideString; safecall;
179 function Get_KernelLogin: WordBool; safecall;
180 function Get_Login: WideString; safecall;
181 function Get_RpcbError: WideString; safecall;
182 function Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs; safecall;
183 function Get_Socket: Integer; safecall;
184 function Get_User: WideString; safecall;
185 procedure Set_KernelLogin(Value: WordBool); safecall;
186 procedure Set_Login(const Value: WideString); safecall;
187 procedure Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs); safecall;
188
189 property ClientName: WideString read FClientName write FClientName;
190 property BrokerUniqueClientId: Longword read FUniqueClientId write FUniqueClientId;
191 property RpcHistory: RPCCallHistory read FRpcCallHistory ;
192 property ConnectType: ISharedBrokerClient read FConnectType write FConnectType;
193 property BrokerConnectionIndex: Integer read GetConnectionIndex;
194 end;
195
196 // TSharedBrokerClientMgr is used as a global container to manage all of the clients of the shared broker
197 // There is a single global instance of this class allocated below called ClientMgr;
198 // Other classes within the RPCSharedBrokerSessionMgr can get at the client information through ClientMgr;
199 // All new Send event methods should be implemented here.
200 TSharedBrokerClientMgr = class
201 private
202 FAllConnections: TList; // The list of unique ServerPort/Shared actual connections
203 FAllConnectedClients: TList; // All Clients connected through a broker connection
204 // are added to this list
205 FAllClients: TList; // Any TSharedBroker is added to this list
206 FNextRpcUniqueId: Longword;
207 FRpcCallHistoryEnabled: boolean;
208 FPerClientRpcHistoryLimit: integer;
209 FNoClientsHaveConnectedYet: boolean;
210 FInProcessOfLoggingOutClients: boolean;
211 FCloseAllClientsWaitTime : Double;
212 FKillClientsStartedTime : Int64;
213 FKillClientsCountdownStarted : boolean;
214
215 procedure SetRpcCallHistoryEnabled(enabled: boolean);
216
217 public
218 constructor Create;
219 destructor Destroy; override;
220
221 // event procedures
222 // SendOnLogout sends the OnLogout event to all attached event controllers.
223 // Messages are sent to both DebuggerClient and BrokerClient types
224 procedure SendOnLogout;
225
226 // SendOnRpcCallRecorded is only sent to DebuggerClient type connections
227 // when any RPC call completes. The unique RPC id of the RPC is sent
228 // as a parameter
229 procedure SendOnRpcCallRecorded(uniqueRpcId: Longword);
230
231 // SendOnClientConnect is only sent to DebuggerClient type connections
232 // when any client successfully connects. The unique Id of that
233 // client is passed as a parameter
234 procedure SendOnClientConnect(uniqueClientId: Integer; connection: ISharedBrokerConnection);
235
236 // SendOnClientDisconnect is only sent to DebuggerClient type connections
237 // when any client disconnects. The unique Id of that
238 // client is passed as a parameter
239 procedure SendOnClientDisconnect(uniqueClientId: Integer);
240
241 // SendOnContextChanged calls the OnContextChanged event handlers on DebbugerClient type
242 // connections.
243 procedure SendOnContextChanged(connectionIndex: Integer; newContext: WideString);
244
245 // SendOnConnectionDropped (or other WSA___ error) calls the OnConnectionDropped event
246 // handlers for DebuggerClient type and for BrokerClient types on the connection that encountered the error.
247 procedure SendOnConnectionDropped(RPCBroker: TRPCBroker; ErrorText: String);
248
249 // Connected Client management mmethods
250 procedure CloseAllClients(maxWaitTime: Integer); // Wait time is in seconds
251 procedure CheckDisconnectWaitTimeAndShutdownClients;
252 procedure ListAllConnectedClients(AList: TStrings);
253 procedure AddConnectedBrokerClient(broker: TSharedBroker);
254 procedure RemoveConnectedBrokerClient(broker: TSharedBroker);
255 function ConnectedClientCount : integer;
256
257 // General Client management methods
258 procedure AddToGeneralClientList(broker: TSharedBroker);
259 procedure RemoveFromGeneralClientList(broker: TSharedBroker);
260 function GeneralClientCount:Integer;
261
262 property AllConnections: TList read FAllConnections write FAllConnections;
263 property NoClientsHaveConnectedYet: Boolean read FNoClientsHaveConnectedYet write FNoClientsHaveConnectedYet;
264
265 // General Methods
266 function Piece(const S: string; Delim: char; PieceNum: Integer): string;
267
268 // Methods for RPC history
269 function GetNextRpcUniqueId: Longword;
270 property RpcCallHistoryEnabled: boolean read FRpcCallHistoryEnabled write SetRpcCallHistoryEnabled;
271 property PerClientRpcHistoryLimit: integer read FPerClientRpcHistoryLimit write FPerClientRpcHistoryLimit;
272
273 function GetRpcCallEntryPtrFromHistory(uniqueRpcId: Longword;
274 out rpcEntryPtr: RPCCallHistoryEntryPointer)
275 : ISharedBrokerErrorCode;
276
277 function GetRpcCallEntryPtrFromHistoryIndex(uniqueClientId: Longword;
278 rpcCallIndex: Integer;
279 out rpcEntryPtr: RPCCallHistoryEntryPointer)
280 : ISharedBrokerErrorCode;
281
282 function GetRpcClientIdFromHistory(uniqueRpcId: Integer;
283 out uniqueClientId: Integer;
284 out clientName: WideString)
285 : ISharedBrokerErrorCode;
286
287 function GetRpcHistoryCountForClient(uniqueClientId: Integer;
288 out rpcCount: Integer)
289 : ISharedBrokerErrorCode;
290
291 function GetClientIdAndNameFromIndex(clientIndex: Integer;
292 out uniqueClientId: Integer;
293 out clientName: WideString)
294 : ISharedBrokerErrorCode;
295
296 function GetClientNameFromUniqueClientId(uniqueClientId: Integer;
297 out clientName: WideString)
298 : ISharedBrokerErrorCode;
299
300 function GetActiveBrokerConnectionIndexFromUniqueClientId(uniqueClientId: Integer;
301 out connectionIndex: Integer)
302 : ISharedBrokerErrorCode;
303
304 procedure OnIdleEventHandler(Sender: TObject; var Done: Boolean);
305
306 property InProcessOfLoggingOutClients: boolean read FInProcessOfLoggingOutClients write FInProcessOfLoggingOutClients;
307 property CloseAllClientsWaitTime: Double read FCloseAllClientsWaitTime write FCloseAllClientsWaitTime;
308
309 end;
310
311 function GetPerformanceCounterTimeInMS: Int64;
312
313
314var
315 ClientMgr: TSharedBrokerClientMgr;
316
317implementation
318
319//uses ComServ;
320uses Messages, ComServ, SysUtils, Forms, {lmdnonvs,} Math, XWBut1,
321 syncobjs, Rpcconf1, MfunStr;
322
323const
324 kUniqueClientIdDefault: Longword = 0;
325 kClientNameDefault: string = 'UNNAMED';
326 kNextRpcUniqueIdInitialValue: Longword = 1; // Start numbering at 1
327 kRpcCallHistoryEnabledDefault: boolean = false;
328 kPerClientRpcHistoryLimitDefault: integer = 10;
329 kUnassignedString: string = 'UNASSIGNED';
330 kNoneString: string = 'NONE';
331
332procedure SetBrokerLogin(Str: String; Broker: TRPCBroker);
333const
334 SEP_FS = #28;
335 SEP_GS = #29;
336var
337 StrFS, StrGS: String;
338 DivLst: String;
339 ModeVal: String;
340
341 function TorF(Value: String): Boolean;
342 begin
343 Result := False;
344 if Value = '1' then
345 Result := True;
346 end;
347
348begin
349 with Broker.Login do
350 begin
351 StrFS := SEP_FS;
352 StrGS := SEP_GS;
353 LoginHandle := Piece(Str,StrFS,1);
354 NTToken := Piece(Str,StrFS,2);
355 AccessCode := Piece(Str,StrFS,3);
356 VerifyCode := Piece(Str,StrFS,4);
357 Division := Piece(Str,StrFS,5);
358 ModeVal := Piece(Str,StrFS,6);
359 DivLst := Piece(Str,StrFS,7);
360 MultiDivision := TorF(Piece(Str,StrFS,8));
361 DUZ := Piece(Str,StrFS,9);
362 PromptDivision := TorF(Piece(Str,StrFS,10));
363 ErrorText := Piece(Str,StrFS,11);
364 if ModeVal = '1' then
365 Mode := lmAVCodes
366 else if ModeVal = '2' then
367 Mode := lmAppHandle
368 else if ModeVal = '3' then
369 Mode := lmNTToken;
370 end; // with
371end;
372
373function GetBrokerLogin(Broker: TRPCBroker): WideString;
374
375 function TorF1(Value: Boolean): String;
376 begin
377 Result := '0';
378 if Value then
379 Result := '1';
380 end;
381
382const
383 SEP_FS = #28;
384 SEP_GS = #29;
385var
386 I: Integer;
387 Str: String;
388 ModeVal: String;
389 DivLst: String;
390 MultiDiv: String;
391 PromptDiv: String;
392 StrFS, StrGS: String;
393begin
394 Str := '';
395 with Broker.Login do
396 begin
397 StrFS := SEP_FS;
398 StrGS := SEP_GS;
399 ModeVal := '';
400 if Mode = lmAVCodes then
401 ModeVal := '1'
402 else if Mode = lmAppHandle then
403 ModeVal := '2'
404 else if Mode = lmNTToken then
405 ModeVal := '3';
406 DivLst := '';
407 for i := 0 to Pred(DivList.Count) do
408 DivLst := DivLst + DivList[i] + SEP_GS;
409 MultiDiv := TorF1(MultiDivision);
410 PromptDiv := TorF1(PromptDivision);
411 Str := LoginHandle + StrFS + NTToken + StrFS + AccessCode + StrFS;
412 Str := Str + VerifyCode + StrFS + Division + StrFS + ModeVal + StrFS;
413 Str := Str + DivLst + StrFS + MultiDiv + StrFS + DUZ + StrFS;
414 Str := Str + PromptDiv + StrFS + ErrorText + StrFS;
415 end; // with
416 Result := Str;
417end;
418
419
420function GetPerformanceCounterTimeInMS: Int64;
421var
422 frequency: Int64;
423 performanceCount: Int64;
424 useNonPerformanceCounter: boolean;
425begin
426 useNonPerformanceCounter := false;
427 Result := 0;
428
429 if QueryPerformanceFrequency(frequency) then
430 begin
431 if frequency >= kMillisecondTicksPerSecond then
432 begin
433 if QueryPerformanceCounter(performanceCount) then
434 begin
435 Result := Trunc((performanceCount* kMillisecondTicksPerSecond)/frequency);
436 end else
437 begin
438 useNonPerformanceCounter := true;
439 end;
440 end else
441 begin
442 useNonPerformanceCounter := true;
443 end;
444 end else
445 begin
446 useNonPerformanceCounter := true;
447 end;
448
449 if useNonPerformanceCounter = true then
450 Result := GetTickCount;
451end;
452
453
454procedure TSharedBroker.EventSinkChanged(const EventSink: IUnknown);
455begin
456 FEvents := EventSink as ISharedBrokerEvents;
457end;
458
459function TSharedBroker.GetEnumerator: IEnumConnections;
460var
461 Container: IConnectionPointContainer;
462 ConnectionPoint: IConnectionPoint;
463begin
464 OleCheck(QueryInterface(IConnectionPointContainer,Container));
465 OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID,ConnectionPoint));
466 ConnectionPoint.EnumConnections(Result);
467end;
468
469procedure TSharedBroker.Initialize;
470begin
471 inherited Initialize;
472 FConnectionPoints := TConnectionPoints.Create(Self);
473 FUniqueClientId := kUniqueClientIdDefault;
474 FClientName := kClientNameDefault;
475 FRpcCallHistory := RPCCallHistory.Create();
476
477 // Use this for multiple client connections to this server
478 if AutoFactory.EventTypeInfo <> nil then
479 FConnectionPoints.CreateConnectionPoint(
480 AutoFactory.EventIID, ckMulti, EventConnect);
481
482 // add both connected and non connected clients to the general client list
483 ClientMgr.AddToGeneralClientList(self);
484 FInGeneralClientList := true;
485
486end;
487
488
489destructor TSharedBroker.Destroy;
490begin
491 DoDisconnect;
492
493 FRpcCallHistory.Free;
494 FRpcCallHistory := nil;
495
496 inherited Destroy;
497
498 // Remove self from the general client list
499 if FInGeneralClientList = true then
500 begin
501 ClientMgr.RemoveFromGeneralClientList(self);
502 FInGeneralClientList := False;
503 end;
504end;
505
506{
507function TSharedBroker.BrokerConnect(const clientName: WideString;
508 connectionType: ISharedBrokerClient; const serverPort: WideString;
509 wantDebug, allowShared: WordBool; rpcTimeLimit: SYSINT;
510 out uniqueClientIId: SYSINT): ISharedBrokerErrorCode;
511}
512function TSharedBroker.BrokerConnect(const ClientName: WideString;
513 ConnectionType: ISharedBrokerClient; const ServerPort: WideString;
514 WantDebug, AllowShared, KernelLoginVal: WordBool;
515 ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
516 var LoginStr: WideString; out UniqueClientIId: SYSINT;
517 out ErrorMsg: WideString): ISharedBrokerErrorCode;
518safecall;
519var
520 aBrokerConnection: TBrokerConnection;
521 i: Integer;
522 connectMessage : ISharedBrokerConnection;
523 serverIP,serverStr: string;
524 port: Integer;
525begin
526 Result := CouldNotConnect;
527 ErrorMsg := '';
528 connectMessage := Failed;
529
530 if connectionType = BrokerClient then
531 begin
532 // First separate out the server/port param into server and port strings
533 // next look up the serverIP from the server name.
534 // If valid proceed otherwise error.
535 serverStr := ClientMgr.Piece(serverPort, ':', 1);
536 // use a default for the port in case it is not sent in
537 port := StrToIntDef(ClientMgr.Piece(ServerPort, ':', 2), 9200);
538
539 serverIP := GetServerIP(serverStr);
540
541 aBrokerConnection := nil;
542 if AllowShared then
543 for i := 0 to Pred(ClientMgr.AllConnections.Count) do
544 // Compare against the server IP and the port since a server name
545 // is not unique.
546 if (TBrokerConnection(ClientMgr.AllConnections.Items[i]).FServerIP = serverIP) and
547// if (TBrokerConnection(ClientMgr.AllConnections.Items[i]).FServerIP = serverStr) and
548 (TBrokerConnection(ClientMgr.AllConnections.Items[i]).FPort = port) and
549 TBrokerConnection(ClientMgr.AllConnections.Items[i]).FShared then
550 aBrokerConnection := TBrokerConnection(ClientMgr.AllConnections.Items[i]);
551
552 if aBrokerConnection = nil then
553 begin
554
555 aBrokerConnection := TBrokerConnection.Create;
556 aBrokerConnection.FBroker := TRPCBroker.Create(Application);
557 ConnectType := BrokerClient;
558
559 with aBrokerConnection.FBroker do
560 begin
561 ClearParameters := True;
562 ClearResults := True;
563 DebugMode := wantDebug;
564// Server := serverIP;
565 Server := serverStr;
566 ListenerPort := port;
567 RPCTimeLimit := rpcTimeLim;
568 KernelLogin := KernelLoginVal;
569 OnPulseError := ClientMgr.SendOnConnectionDropped;
570 SetBrokerLogin(LoginStr, aBrokerConnection.FBroker);
571 if ShowErrMsgs = isemRaise then
572 ShowErrorMsgs := semRaise
573 else
574 ShowErrorMsgs := semQuiet;
575 try
576 Connected := True;
577 ErrorMsg := RPCBError;
578 except
579 ErrorMsg := RPCBError;
580 end;
581 end;
582
583 LoginStr := GetBrokerLogin(aBrokerConnection.FBroker);
584 aBrokerConnection.FShared := allowShared;
585 aBrokerConnection.FServer := serverStr;
586 aBrokerConnection.FPort := port;
587 aBrokerConnection.FServerIP := serverIP;
588 aBrokerConnection.FConnectionIndex := ClientMgr.AllConnections.Count;
589
590 if aBrokerConnection.FBroker.Connected = true then
591 begin
592 ClientMgr.AllConnections.Add(aBrokerConnection);
593 if aBrokerConnection.FShared then // Set up for cleaning between RPC calls
594 begin
595 aBrokerConnection.FBroker.RemoteProcedure := 'XUS SET SHARED';
596 aBrokerConnection.FBroker.Param.Clear;
597 aBrokerConnection.FBroker.Call;
598 end;
599 end;
600
601 connectMessage := New;
602 end else
603 begin
604 connectMessage := Shared;
605 end;
606
607 if aBrokerConnection.FBroker.Connected then
608 begin
609 Result := Success;
610 Inc(aBrokerConnection.FRefCount);
611 FBrokerConnection := aBrokerConnection;
612 end else
613 begin
614 connectMessage := Failed;
615 Result := CouldNotConnect;
616 end;
617 Set_RpcHistoryEnabled(ClientMgr.RpcCallHistoryEnabled);
618 end
619 else if connectionType = DebuggerClient then
620 begin
621 ConnectType := DebuggerClient;
622
623 // Debugger clients enable RPC history for Al clients by default
624 Set_RpcHistoryEnabled(true);
625
626 connectMessage := Debug;
627 Result := Success;
628 end;
629
630 FBrokerContext := '';
631
632
633 FClientName := clientName; // The name passed in should be the name
634 // of the executable
635 BrokerUniqueClientId := Longword(self); // The self pointer is unique and could
636 // be dereference later on so use it.
637 // store it locally for quick access
638 uniqueClientIId := BrokerUniqueClientId;// Put the unique client id back in
639 // the out param as well.
640
641 // Only add connected clients to the connected broker client list
642 if (Result = Success) and (ConnectType <> DebuggerClient)then
643 begin
644 ClientMgr.AddConnectedBrokerClient(self);
645
646 // Be sure to send the OnClientConnect message to any
647 // debugger clients
648 ClientMgr.SendOnClientConnect(BrokerUniqueClientId,connectMessage);
649 end;
650end;
651
652function TSharedBroker.BrokerSetContext(
653 const optionName: WideString): ISharedBrokerErrorCode;
654begin
655 // So don't set the context if it is already the same on
656 // on the current connection. Also store the new context
657 // in the connection.
658 Result := Success;
659 if FBrokerConnection.FLastContext <> optionName then
660 begin
661 if FBrokerConnection.FBroker.CreateContext(optionName) then
662 begin
663 FBrokerConnection.FLastContext := optionName;
664 FBrokerContext := optionName;
665 Result := Success;
666 ClientMgr.SendOnContextChanged(FBrokerConnection.FConnectionIndex,optionName);
667 end else
668 begin
669 Result := CouldNotSetContext;
670 FBrokerConnection.FLastContext := '';
671 FBrokerContext := '';
672 end;
673 end;
674end;
675
676function TSharedBroker.BrokerCall(const rpcName, rpcParams: WideString;
677 rpcTimeLimit: Integer; out rpcResults: WideString;
678 out uniqueRpcCallId: Integer): ISharedBrokerErrorCode;
679const
680 SEP_FS = #28;
681 SEP_GS = #29;
682 SEP_US = #30;
683 SEP_RS = #31;
684var
685 i, curStart, lengthOfrpcParams, endOfSegment: Integer;
686 aRef, aVal: string;
687 startTimeMS, timeElapsedMS: Int64;
688 currentDateTime: TDateTime;
689 rpcEntry: RPCCallHistoryEntry;
690
691 function PosNext(aChar: WideChar; startPos: Integer): Integer;
692 begin
693 Result := 0;
694 while (Result = 0) and (StartPos <= lengthOfrpcParams) do
695 begin
696 if rpcParams[StartPos] = aChar then Result := startPos;
697 Inc(startPos);
698 end;
699 end;
700
701begin
702 Result := Success;
703 rpcResults := '';
704 startTimeMS := 0;
705 currentDateTime := 0;
706
707 BrokerSetContext(FBrokerContext);
708
709 if Result <> Success then Exit;
710
711 // setup and make the RPC call
712 FBrokerConnection.FBroker.ClearParameters := True;
713 FBrokerConnection.FBroker.RemoteProcedure := rpcName;
714
715 // Set RPC timeout
716 FBrokerConnection.FBroker.RPCTimeLimit := rpcTimeLimit;
717
718 curStart := 1;
719 i := 0;
720 lengthOfrpcParams := Length(rpcParams);
721 while curStart < lengthOfrpcParams do
722 begin
723 case rpcParams[curStart] of
724 'L': FBrokerConnection.FBroker.Param[i].PType := literal;
725 'R': FBrokerConnection.FBroker.Param[i].PType := reference;
726 'M': FBrokerConnection.FBroker.Param[i].PType := list;
727 else FBrokerConnection.FBroker.Param[i].PType := undefined;
728 end;
729 Inc(curStart, 2);
730 if FBrokerConnection.FBroker.Param[i].PType = list then
731 begin
732// endOfSegment := 0;
733 while rpcParams[curStart] <> SEP_GS do
734 begin
735 endOfSegment := PosNext(SEP_US, curStart);
736 aRef := Copy(rpcParams, curStart, endOfSegment - curStart);
737 curStart := endOfSegment + 1;
738 endOfSegment := PosNext(SEP_RS, curStart);
739 aVal := Copy(rpcParams, curStart, endOfSegment - curStart);
740 curStart := endOfSegment + 1;
741 FBrokerConnection.FBroker.Param[i].Mult[aRef] := aVal;
742 end; {while rpcParams}
743 {if endOfSegment = 0 then} endOfSegment := PosNext(SEP_GS, curStart);
744 curStart := endOfSegment + 1;
745 end else
746 begin
747 endOfSegment := PosNext(SEP_GS, curStart);
748 FBrokerConnection.FBroker.Param[i].Value :=
749 Copy(rpcParams, curStart, endOfSegment - curStart);
750 curStart := endOfSegment + 1;
751 end; {if Param[i].PType ... else}
752 Inc(i);
753 end; {while curStart}
754
755 if Get_RpcHistoryEnabled = true then
756 begin
757 // Get the current time and date of this call
758 // start the millisecond counter
759 startTimeMS := GetPerformanceCounterTimeInMS;
760 currentDateTime := Date;
761 end;
762
763 FBrokerConnection.FBroker.Call;
764
765 RPCResults := FBrokerConnection.FBroker.Results.Text;
766
767 if FBrokerConnection.FBroker.RPCBError <> '' then
768 Result := GeneralFailure;
769
770 if ClientMgr.RpcCallHistoryEnabled then
771 begin
772 timeElapsedMS := GetPerformanceCounterTimeInMS - startTimeMS;
773
774 rpcEntry := RPCCallHistoryEntry.Create(
775 FBrokerContext,
776 rpcName,
777 rpcParams,
778 RPCResults,
779 Double(currentDateTime),
780 Longword(timeElapsedMS),
781 BrokerUniqueClientId
782 );
783
784 RpcHistory.Add(rpcEntry);
785
786 // Now fire the event so any debugger connected can
787 // read it
788 ClientMgr.SendOnRpcCallRecorded(rpcEntry.UniqueRPCCallId);
789 end;
790end;
791
792procedure TSharedBroker.DoDisconnect;
793begin
794 if FBrokerConnection<>nil then
795 begin
796 Dec(FBrokerConnection.FRefCount);
797 if FBrokerConnection.FRefCount = 0 then
798 begin
799 if ConnectType = BrokerClient then
800 FBrokerConnection.FBroker.Destroy;
801
802 if ClientMgr <> nil then
803 ClientMgr.AllConnections.Remove(FBrokerConnection);
804
805 FBrokerConnection.Free;
806 end;
807
808 FBrokerConnection := nil;
809 FBrokerContext := '';
810
811 if ConnectType <> DebuggerClient then
812 begin
813 ClientMgr.RemoveConnectedBrokerClient(Self);
814 // Send a message to all debugger clients that
815 // a non-debugger client has disconnected
816 ClientMgr.SendOnClientDisconnect(BrokerUniqueClientId);
817 end;
818 end;
819end;
820
821function TSharedBroker.BrokerDisconnect: ISharedBrokerErrorCode;
822begin
823 DoDisconnect;
824 Result := Success;
825end;
826
827function TSharedBroker.ReadRegDataDefault(Root: IRegistryRootEnum;
828 const Key, Name, Default: WideString;
829 out RegResult: WideString): ISharedBrokerErrorCode;
830var
831 marshalledRoot: LongWord;
832begin
833 // do a little data marshaling here
834 case Root of
835 IRegistryRootEnum(HKCR) : marshalledRoot := HKCR;
836 IRegistryRootEnum(HKCU) : marshalledRoot := HKCU;
837 IRegistryRootEnum(HKLM) : marshalledRoot := HKLM;
838 IRegistryRootEnum(HKU) : marshalledRoot := HKU;
839 IRegistryRootEnum(HKCC) : marshalledRoot := HKCC;
840 else
841 marshalledRoot := HKDD;
842 end;
843
844 regResult := XWBut1.ReadRegDataDefault(marshalledRoot,key,name,default);
845 Result := Success;
846end;
847
848function TSharedBroker.Get_RpcVersion: WideString;
849begin
850 if FBrokerConnection <> nil then
851 begin
852 Result := FBrokerConnection.FBroker.RpcVersion;
853 end else
854 begin
855 // Don't know what else to make this if we don't actually have a TRPCBroker to ask
856 Result := '0';
857 end;
858end;
859
860procedure TSharedBroker.Set_RpcVersion(const version: WideString);
861begin
862 if FBrokerConnection <> nil then
863 begin
864 FBrokerConnection.FBroker.RpcVersion := version;
865 end
866end;
867
868function TSharedBroker.Get_PerClientRpcHistoryLimit: Integer;
869begin
870 Result := ClientMgr.PerClientRpcHistoryLimit;
871end;
872
873function TSharedBroker.Get_RpcHistoryEnabled: WordBool;
874begin
875 // If debugger client then operate on all of the clients
876 // else just operate on this one
877 if ConnectType = DebuggerClient then
878 Result := ClientMgr.RpcCallHistoryEnabled
879 else
880 Result := RpcHistory.Enabled;
881end;
882
883function TSharedBroker.GetConnectedClientCount(
884 out connectedClientCount: Integer): ISharedBrokerErrorCode;
885begin
886 connectedClientCount := ClientMgr.ConnectedClientCount;
887
888 Result := Success;
889end;
890
891function TSharedBroker.GetRpcCallFromHistory(uniqueRpcId: Integer;
892 out uniqueClientId: Integer; out brokerContext, rpcName, rpcParams,
893 rpcResult: WideString; out rpcStartDateTime: Double;
894 out rpcDuration: Integer): ISharedBrokerErrorCode;
895var
896 rpcEntryPtr: RPCCallHistoryEntryPointer;
897begin
898 Result := ClientMgr.GetRPCCallEntryPtrFromHistory(uniqueRpcId,rpcEntryPtr);
899
900 if Result = Success then
901 begin
902 uniqueClientId := rpcEntryPtr^.BrokerUniqueClientId;
903 brokerContext := rpcEntryPtr^.CallContext;
904 rpcName := rpcEntryPtr^.CallName;
905 rpcParams := rpcEntryPtr^.CallParams;
906 rpcResult := rpcEntryPtr^.CallResults;
907 rpcStartDateTime := rpcEntryPtr^.CallStartDateTime;
908 rpcDuration := rpcEntryPtr^.CallDurationInMS;
909 end else
910 begin
911 uniqueClientId := 0;
912 brokerContext := '';
913 rpcName := '';
914 rpcParams := '';
915 rpcResult := '';
916 rpcStartDateTime := 0;
917 rpcDuration := 0;
918 end;
919end;
920
921function TSharedBroker.GetRpcCallFromHistoryIndex(uniqueClientId,
922 rpcCallIndex: Integer; out uniqueRpcId: Integer; out brokerContext,
923 rpcName, rpcParams, rpcResult: WideString; out rpcStartDateTime: Double;
924 out rpcDuration: Integer): ISharedBrokerErrorCode;
925var
926 rpcEntryPtr: RPCCallHistoryEntryPointer;
927begin
928 Result := ClientMgr.GetRPCCallEntryPtrFromHistoryIndex(uniqueClientId,rpcCallIndex,rpcEntryPtr);
929
930 if Result = Success then
931 begin
932 uniqueRpcId := rpcEntryPtr^.UniqueRPCCallId;
933 brokerContext := rpcEntryPtr^.CallContext;
934 rpcName := rpcEntryPtr^.CallName;
935 rpcParams := rpcEntryPtr^.CallParams;
936 rpcResult := rpcEntryPtr^.CallResults;
937 rpcStartDateTime := rpcEntryPtr^.CallStartDateTime;
938 rpcDuration := rpcEntryPtr^.CallDurationInMS;
939 end else
940 begin
941 uniqueRpcId := 0;
942 brokerContext := '';
943 rpcName := '';
944 rpcParams := '';
945 rpcResult := '';
946 rpcStartDateTime := 0;
947 rpcDuration := 0;
948 end;
949end;
950
951
952function TSharedBroker.GetClientIdAndNameFromIndex(clientIndex: Integer;
953 out uniqueClientId: Integer;
954 out clientName: WideString): ISharedBrokerErrorCode;
955begin
956 Result := ClientMgr.GetClientIdAndNameFromIndex(clientIndex,uniqueClientId,clientName);
957 // Failure defaults are taken care of by ClientMgr.
958end;
959
960function TSharedBroker.GetRpcClientIdFromHistory(uniqueRpcId: Integer;
961 out uniqueClientId: Integer;
962 out clientName: WideString): ISharedBrokerErrorCode;
963begin
964 Result := ClientMgr.GetRPCClientIdFromHistory(uniqueRpcId,uniqueClientId,clientName);
965
966 if Result <> Success then
967 begin
968 uniqueClientId := 0;
969 clientName := '';
970 end;
971end;
972
973function TSharedBroker.GetRpcHistoryCountForClient(uniqueClientId: Integer;
974 out rpcHistoryCount: Integer): ISharedBrokerErrorCode;
975begin
976 Result := ClientMgr.GetRpcHistoryCountForClient(uniqueClientId,rpcHistoryCount);
977
978 if Result <> Success then
979 rpcHistoryCount := 0;
980end;
981
982procedure TSharedBroker.Set_PerClientRpcHistoryLimit(limit: Integer);
983begin
984 ClientMgr.PerClientRpcHistoryLimit := limit;
985end;
986
987procedure TSharedBroker.Set_RpcHistoryEnabled(enabled: WordBool);
988begin
989 // If debugger client then operate on all of the clients
990 // else just operate on this one
991 if ConnectType = DebuggerClient then
992 ClientMgr.RpcCallHistoryEnabled := enabled
993 else
994 RpcHistory.Enabled := enabled;
995end;
996
997function TSharedBroker.LogoutConnectedClients(
998 logoutTimeLimit: Integer): ISharedBrokerErrorCode;
999begin
1000 ClientMgr.CloseAllClients(logoutTimeLimit);
1001 ClientMgr.InProcessOfLoggingOutClients := true;
1002 Result := Success;
1003end;
1004
1005function TSharedBroker.GetClientNameFromUniqueClientId(
1006 uniqueClientId: Integer;
1007 out clientName: WideString): ISharedBrokerErrorCode;
1008begin
1009 Result := ClientMgr.GetClientNameFromUniqueClientId(uniqueClientId,clientName);
1010end;
1011
1012function TSharedBroker.GetActiveBrokerConnectionIndexCount(
1013 out connectionIndexCount: Integer): ISharedBrokerErrorCode;
1014begin
1015 connectionIndexCount := ClientMgr.AllConnections.Count;
1016 Result := Success;
1017end;
1018
1019function TSharedBroker.GetActiveBrokerConnectionIndexFromUniqueClientId(
1020 uniqueClientId: Integer;
1021 out connectionIndex: Integer): ISharedBrokerErrorCode;
1022begin
1023 Result := ClientMgr.GetActiveBrokerConnectionIndexFromUniqueClientId(uniqueClientId,connectionIndex);
1024end;
1025
1026function TSharedBroker.GetActiveBrokerConnectionInfo(connectionIndex: Integer;
1027 out connectedServerIp: WideString; out connectedServerPort: Integer;
1028 out lastContext: WideString): ISharedBrokerErrorCode;
1029begin
1030 Result := ConnectionIndexOutOfRange;
1031
1032 if (connectionIndex >= 0) and (connectionIndex < ClientMgr.AllConnections.Count) then
1033 begin
1034 with TBrokerConnection(ClientMgr.AllConnections.Items[connectionIndex]) do
1035 begin
1036 connectedServerIp := FServerIP;
1037 connectedServerPort := FPort;
1038 lastContext := FLastContext;
1039 Result := Success;
1040 end;
1041 end;
1042end;
1043
1044function TSharedBroker.GetConnectionIndex: Integer;
1045begin
1046 Result := FBrokerConnection.FConnectionIndex;
1047end;
1048
1049constructor TSharedBrokerClientMgr.Create;
1050begin
1051 inherited;
1052 FAllConnections := TList.Create;
1053 FAllConnectedClients := TList.Create;
1054 FAllClients := TList.Create;
1055 FNoClientsHaveConnectedYet := True;
1056
1057 FNextRpcUniqueId := kNextRpcUniqueIdInitialValue;
1058 RpcCallHistoryEnabled := kRpcCallHistoryEnabledDefault;
1059 PerClientRpcHistoryLimit := kPerClientRpcHistoryLimitDefault;
1060 InProcessOfLoggingOutClients := false;
1061 CloseAllClientsWaitTime := kCloseAllClientsWaitTimeDefault;
1062
1063 FKillClientsStartedTime := 0;
1064 FKillClientsCountdownStarted := false;
1065end;
1066
1067destructor TSharedBrokerClientMgr.Destroy;
1068begin
1069 FAllConnections.Free;
1070 FAllConnectedClients.Free;
1071 FAllClients.Free;
1072 inherited;
1073end;
1074
1075procedure TSharedBrokerClientMgr.SendOnLogout;
1076var
1077 Enum: IEnumConnections;
1078 ConnectData: TConnectData;
1079 Fetched: Cardinal;
1080 aBrokerClient: TSharedBroker;
1081 i: Integer;
1082begin
1083 for i := Pred(FAllClients.Count) downto 0 do
1084 begin
1085 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1086 if aBrokerClient <> nil then
1087 begin
1088 Enum := aBrokerClient.GetEnumerator;
1089 if Enum <> nil then
1090 begin
1091
1092 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1093 begin
1094 if ConnectData.pUnk <> nil then
1095 try
1096 (ConnectData.pUnk as ISharedBrokerEvents).OnLogout;
1097 except
1098 end;
1099 end;
1100 end;
1101 end;
1102 end;
1103end;
1104
1105procedure TSharedBrokerClientMgr.SendOnRpcCallRecorded(uniqueRpcId: Longword);
1106var
1107 Enum: IEnumConnections;
1108 ConnectData: TConnectData;
1109 Fetched: Cardinal;
1110 aBrokerClient: TSharedBroker;
1111 i: Integer;
1112
1113begin
1114 for i := Pred(FAllClients.Count) downto 0 do
1115 begin
1116 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1117 if aBrokerClient <> nil then
1118 begin
1119 // only send these events to Debugger type clients
1120 if aBrokerClient.ConnectType = DebuggerClient then
1121 begin
1122 Enum := aBrokerClient.GetEnumerator;
1123 if Enum <> nil then
1124 begin
1125 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1126 if ConnectData.pUnk <> nil then
1127 try
1128 (ConnectData.pUnk as ISharedBrokerEvents).OnRpcCallRecorded(uniqueRpcId);
1129 except
1130 end;
1131 end;
1132 end;
1133 end;
1134 end;
1135end;
1136
1137procedure TSharedBrokerClientMgr.SendOnClientConnect(uniqueClientId: Integer;connection: ISharedBrokerConnection);
1138var
1139 Enum: IEnumConnections;
1140 ConnectData: TConnectData;
1141 Fetched: Cardinal;
1142 aBrokerClient: TSharedBroker;
1143 i: Integer;
1144
1145begin
1146 for i := Pred(FAllClients.Count) downto 0 do
1147 begin
1148 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1149 if aBrokerClient <> nil then
1150 begin
1151 // only send these events to Debugger type clients
1152 if aBrokerClient.ConnectType = DebuggerClient then
1153 begin
1154 Enum := aBrokerClient.GetEnumerator;
1155 if Enum <> nil then
1156 begin
1157 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1158 if ConnectData.pUnk <> nil then
1159 try
1160 (ConnectData.pUnk as ISharedBrokerEvents).OnClientConnect(uniqueClientId,connection);
1161 except
1162 end;
1163 end;
1164 end;
1165 end;
1166 end;
1167end;
1168
1169procedure TSharedBrokerClientMgr.SendOnClientDisconnect(uniqueClientId: Integer);
1170var
1171 Enum: IEnumConnections;
1172 ConnectData: TConnectData;
1173 Fetched: Cardinal;
1174 aBrokerClient: TSharedBroker;
1175 i: Integer;
1176
1177begin
1178 if FAllClients <> nil then
1179 for i := Pred(FAllClients.Count) downto 0 do
1180 begin
1181 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1182 if aBrokerClient <> nil then
1183 begin
1184 // only send these events to Debugger type clients
1185 if aBrokerClient.ConnectType = DebuggerClient then
1186 begin
1187 Enum := aBrokerClient.GetEnumerator;
1188 if Enum <> nil then
1189 begin
1190 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1191 if ConnectData.pUnk <> nil then
1192 try
1193 (ConnectData.pUnk as ISharedBrokerEvents).OnClientDisconnect(uniqueClientId);
1194 except
1195 end;
1196 end;
1197 end;
1198 end;
1199 end;
1200end;
1201
1202procedure TSharedBrokerClientMgr.SendOnContextChanged(connectionIndex: Integer; newContext: WideString);
1203var
1204 Enum: IEnumConnections;
1205 ConnectData: TConnectData;
1206 Fetched: Cardinal;
1207 aBrokerClient: TSharedBroker;
1208 i: Integer;
1209
1210begin
1211 if FAllClients <> nil then
1212 for i := Pred(FAllClients.Count) downto 0 do
1213 begin
1214 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1215 if aBrokerClient <> nil then
1216 begin
1217 // only send these events to Debugger type clients
1218 if aBrokerClient.ConnectType = DebuggerClient then
1219 begin
1220 Enum := aBrokerClient.GetEnumerator;
1221 if Enum <> nil then
1222 begin
1223 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1224 if ConnectData.pUnk <> nil then
1225 try
1226 (ConnectData.pUnk as ISharedBrokerEvents).OnContextChanged(connectionIndex,newContext);
1227 except
1228 end;
1229 end;
1230 end;
1231 end;
1232 end;
1233end;
1234
1235procedure TSharedBrokerClientMgr.SendOnConnectionDropped(RPCBroker: TRPCBroker; ErrorText: String);
1236var
1237 Enum: IEnumConnections;
1238 ConnectData: TConnectData;
1239 Fetched: Cardinal;
1240 aBrokerClient: TSharedBroker;
1241 i: Integer;
1242 IsRightConnection: Boolean;
1243 ConnectionIndex: Integer;
1244begin
1245 ConnectionIndex := 0;
1246 // first pass -- get BrokerClients and identify ConnectionIndex's
1247 if FAllClients <> nil then
1248 for i := Pred(FAllClients.Count) downto 0 do
1249 begin
1250 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1251 if aBrokerClient <> nil then
1252 begin
1253 IsRightConnection := False;
1254 if ABrokerClient.ConnectType <> DebuggerClient then
1255 begin
1256 if ABrokerClient.FBrokerConnection.FBroker = RPCBroker then
1257 begin
1258 IsRightConnection := True;
1259 ConnectionIndex := ABrokerClient.FBrokerConnection.FConnectionIndex;
1260 end;
1261 if IsRightConnection then
1262 begin
1263 Enum := aBrokerClient.GetEnumerator;
1264 if Enum <> nil then
1265 begin
1266 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1267 if ConnectData.pUnk <> nil then
1268 try
1269 (ConnectData.pUnk as ISharedBrokerEvents).OnConnectionDropped(ConnectionIndex,ErrorText);
1270 except
1271 end;
1272 end;
1273 end;
1274 end;
1275 end;
1276 end;
1277 // Now get Debuggers
1278 if FAllClients <> nil then
1279 for i := Pred(FAllClients.Count) downto 0 do
1280 begin
1281 aBrokerClient := TSharedBroker(FAllClients.Items[i]);
1282 if aBrokerClient <> nil then
1283 begin
1284 // only send these events to Debugger type clients
1285 if aBrokerClient.ConnectType = DebuggerClient then
1286 begin
1287 Enum := aBrokerClient.GetEnumerator;
1288 if Enum <> nil then
1289 begin
1290 while Enum.Next(1,ConnectData, @Fetched) = S_OK do
1291 if ConnectData.pUnk <> nil then
1292 try
1293 (ConnectData.pUnk as ISharedBrokerEvents).OnConnectionDropped(ConnectionIndex,ErrorText);
1294 except
1295 end;
1296 end;
1297 end;
1298 end;
1299 end;
1300end;
1301
1302
1303procedure TSharedBrokerClientMgr.CloseAllClients(maxWaitTime: Integer);
1304begin
1305 if maxWaitTime > 0 then
1306 // Since maxWaitTime is in seconds we need to scale by 1000ms/sec
1307 CloseAllClientsWaitTime := maxWaitTime * kMilliSecondScale
1308 else
1309 CloseAllClientsWaitTime := kCloseAllClientsWaitTimeDefault;
1310
1311 // Be sure to send the OnLogout message to all clients
1312 ClientMgr.SendOnLogout;
1313 FKillClientsCountdownStarted := true;
1314 FKillClientsStartedTime := GetTickCount; // use MS calculations
1315end;
1316
1317procedure TSharedBrokerClientMgr.CheckDisconnectWaitTimeAndShutdownClients;
1318var
1319 ABrokerClient: TSharedBroker;
1320 i: Integer;
1321 timeElapsedMS: Double;
1322begin
1323 if FKillClientsCountdownStarted = true then
1324 begin
1325 if FAllClients.Count > 0 then
1326 begin
1327 timeElapsedMS := GetTickCount - FKillClientsStartedTime;
1328 if timeElapsedMS > CloseAllClientsWaitTime then
1329 begin
1330 // Put up a warning dialog that all RPC connections will now be terminated
1331 Application.MessageBox('All client connections will now be terminated!','RPCSharedBrokerSessionMgr Warning',MB_ICONWARNING);
1332 for i := Pred(FAllClients.Count) downto 0 do
1333 begin
1334 ABrokerClient := TSharedBroker(FAllClients.Items[i]);
1335 if ABrokerClient <> nil then ABrokerClient.DoDisconnect;
1336 end;
1337 end;
1338 end;
1339 end;
1340end;
1341
1342procedure TSharedBrokerClientMgr.ListAllConnectedClients(AList: TStrings);
1343var
1344 aBrokerClient: TSharedBroker;
1345 i: Integer;
1346begin
1347 for i := 0 to Pred(ConnectedClientCount) do
1348 begin
1349 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1350 AList.Add(ABrokerClient.FBrokerConnection.FServer+':'+
1351 ABrokerClient.FBrokerConnection.FServerIP+':'+
1352 IntToStr(ABrokerClient.FBrokerConnection.FPort)+'> <'+
1353 ABrokerClient.ClientName+'> '+
1354 ABrokerClient.FBrokerContext);
1355 end;
1356end;
1357
1358procedure TSharedBrokerClientMgr.AddConnectedBrokerClient(broker: TSharedBroker);
1359begin
1360 if broker <> nil then
1361 FAllConnectedClients.Add(broker);
1362end;
1363
1364procedure TSharedBrokerClientMgr.RemoveConnectedBrokerClient(broker: TSharedBroker);
1365begin
1366 if broker <> nil then
1367 FAllConnectedClients.Remove(broker);
1368end;
1369
1370procedure TSharedBrokerClientMgr.AddToGeneralClientList(broker: TSharedBroker);
1371begin
1372 if broker <> nil then
1373 begin
1374 FAllClients.Add(broker);
1375 NoClientsHaveConnectedYet := false;
1376 end;
1377end;
1378
1379procedure TSharedBrokerClientMgr.RemoveFromGeneralClientList(broker: TSharedBroker);
1380begin
1381 if broker <> nil then
1382 FAllClients.Remove(broker);
1383end;
1384
1385function TSharedBrokerClientMgr.ConnectedClientCount : integer;
1386begin
1387 Result := FAllConnectedClients.Count;
1388end;
1389
1390function TSharedBrokerClientMgr.GetNextRpcUniqueId: Longword;
1391begin
1392 FNextRpcUniqueId := FNextRpcUniqueId + 1; // Let this wrap it should be ok.
1393 Result := FNextRpcUniqueId;
1394end;
1395
1396function TSharedBrokerClientMgr.GetRPCCallEntryPtrFromHistory(uniqueRpcId: Longword;
1397 out rpcEntryPtr: RPCCallHistoryEntryPointer)
1398 : ISharedBrokerErrorCode;
1399var
1400 aBrokerClient: TSharedBroker;
1401 i,count: Integer;
1402
1403begin
1404 count := Pred(ConnectedClientCount);
1405
1406 Result := UniqueRPCIdDoesNotExist;
1407
1408 for i := count downto 0 do
1409 begin
1410 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1411 if aBrokerClient <> nil then
1412 begin
1413 Result := aBrokerClient.RpcHistory.GetRPCCallEntryPtr(uniqueRpcId,rpcEntryPtr);
1414 if Result = Success then
1415 Exit;
1416 end;
1417 end;
1418end;
1419
1420function TSharedBrokerClientMgr.GetRPCCallEntryPtrFromHistoryIndex(uniqueClientId:Longword;
1421 rpcCallIndex: Integer;
1422 out rpcEntryPtr: RPCCallHistoryEntryPointer)
1423 : ISharedBrokerErrorCode;
1424var
1425 aBrokerClient: TSharedBroker;
1426 i,count: Integer;
1427
1428begin
1429 count := Pred(ConnectedClientCount);
1430
1431 Result := UniqueClientIdDoesNotExist;
1432
1433 for i := count downto 0 do
1434 begin
1435 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1436
1437 if aBrokerClient <> nil then
1438 begin
1439 if (aBrokerClient.BrokerUniqueClientId = uniqueClientId) then
1440 begin
1441 Result := aBrokerClient.RpcHistory.GetRPCCallEntryPtrFromIndex(rpcCallIndex,rpcEntryPtr);
1442 Exit;
1443 end;
1444 end;
1445 end;
1446end;
1447
1448function TSharedBrokerClientMgr.GetRPCClientIdFromHistory(uniqueRpcId: Integer;
1449 out uniqueClientId: Integer;
1450 out clientName: WideString)
1451 : ISharedBrokerErrorCode;
1452var
1453 aBrokerClient: TSharedBroker;
1454 i,count: Integer;
1455
1456begin
1457 count := Pred(ConnectedClientCount);
1458
1459 Result := UniqueRPCIdDoesNotExist;
1460
1461 for i := count downto 0 do
1462 begin
1463 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1464
1465 if aBrokerClient <> nil then
1466 begin
1467 Result := aBrokerClient.RpcHistory.GetRPCCallClientId(uniqueRpcId,uniqueClientId);
1468 if Result = Success then
1469 begin
1470 clientName := aBrokerClient.ClientName;
1471 Exit;
1472 end;
1473 end;
1474 end;
1475end;
1476
1477function TSharedBrokerClientMgr.GetRPCHistoryCountForClient(uniqueClientId: Integer;
1478 out rpcCount: Integer)
1479 : ISharedBrokerErrorCode;
1480var
1481 aBrokerClient: TSharedBroker;
1482 i,count: Integer;
1483
1484begin
1485 count := Pred(ConnectedClientCount);
1486
1487 Result := UniqueClientIdDoesNotExist;
1488
1489 for i := count downto 0 do
1490 begin
1491 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1492
1493 if aBrokerClient <> nil then
1494 begin
1495 if Integer(aBrokerClient.BrokerUniqueClientId) = Integer(uniqueClientId) then
1496 begin
1497 rpcCount := aBrokerClient.RpcHistory.Count;
1498 Result := Success;
1499 Exit;
1500 end;
1501 end;
1502 end;
1503end;
1504
1505function TSharedBrokerClientMgr.GetClientIdAndNameFromIndex(clientIndex: Integer;
1506 out uniqueClientId: Integer;
1507 out clientName: WideString)
1508 : ISharedBrokerErrorCode;
1509var
1510 aBrokerClient: TSharedBroker;
1511begin
1512 if (clientIndex >= 0) and (clientIndex < FAllConnectedClients.Count) then
1513 begin
1514 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[clientIndex]);
1515 if aBrokerClient <> nil then
1516 begin
1517 uniqueClientId := aBrokerClient.BrokerUniqueClientId;
1518 clientName := aBrokerClient.ClientName;
1519 Result := Success;
1520 end else
1521 Result := NilClientPointer;
1522 end else
1523 Result := ClientIndexOutOfRange;
1524
1525 if Result <> Success then
1526 begin
1527 uniqueClientId := 0;
1528 clientName := '';
1529 end;
1530end;
1531
1532function TSharedBrokerClientMgr.GetClientNameFromUniqueClientId(uniqueClientId: Integer;
1533 out clientName: WideString)
1534 : ISharedBrokerErrorCode;
1535var
1536 aBrokerClient: TSharedBroker;
1537 i,count: Integer;
1538
1539begin
1540 count := Pred(ConnectedClientCount);
1541
1542 Result := UniqueClientIdDoesNotExist;
1543
1544 for i := count downto 0 do
1545 begin
1546 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1547
1548 if aBrokerClient <> nil then
1549 begin
1550 if Integer(aBrokerClient.BrokerUniqueClientId) = Integer(uniqueClientId) then
1551 begin
1552 clientName := aBrokerClient.ClientName;
1553 Result := Success;
1554 Exit;
1555 end;
1556 end;
1557 end;
1558end;
1559
1560function TSharedBrokerClientMgr.GetActiveBrokerConnectionIndexFromUniqueClientId(uniqueClientId: Integer;
1561 out connectionIndex: Integer)
1562 : ISharedBrokerErrorCode;
1563
1564var
1565 aBrokerClient: TSharedBroker;
1566 i,count: Integer;
1567begin
1568 count := Pred(ConnectedClientCount);
1569 Result := UniqueClientIdDoesNotExist;
1570 for i := count downto 0 do
1571 begin
1572 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1573
1574 if aBrokerClient <> nil then
1575 begin
1576 if Integer(aBrokerClient.BrokerUniqueClientId) = Integer(uniqueClientId) then
1577 begin
1578 connectionIndex := aBrokerClient.BrokerConnectionIndex;
1579 Result := Success;
1580 Exit;
1581 end;
1582 end;
1583 end;
1584end;
1585
1586procedure TSharedBrokerClientMgr.SetRpcCallHistoryEnabled(enabled: boolean);
1587
1588var
1589 aBrokerClient: TSharedBroker;
1590 i,count: Integer;
1591
1592begin
1593 // be sure to set the local state
1594 FRpcCallHistoryEnabled := enabled;
1595
1596 count := Pred(ConnectedClientCount);
1597
1598 for i := count downto 0 do
1599 begin
1600 aBrokerClient := TSharedBroker(FAllConnectedClients.Items[i]);
1601 if aBrokerClient <> nil then
1602 begin
1603 // Set the RpcCallHistory for all of the broker connections
1604 aBrokerClient.RpcHistory.Enabled := enabled;
1605 end;
1606 end;
1607
1608end;
1609
1610function TSharedBrokerClientMgr.GeneralClientCount:Integer;
1611begin
1612 if FAllClients <> nil then
1613 Result:= FAllClients.Count
1614 else
1615 Result:= 0;
1616end;
1617
1618procedure TSharedBrokerClientMgr.OnIdleEventHandler(Sender: TObject; var Done: Boolean);
1619begin
1620 // Shut me down any time the client count goes to zero
1621 // Since this server is non visual it has to be able to shut
1622 // down automatically.
1623 // It is started up automatically any time a client tries
1624 // to connect
1625 if (ClientMgr.InProcessOfLoggingOutClients = true) then
1626 ClientMgr.CheckDisconnectWaitTimeAndShutdownClients;
1627
1628 if (GeneralClientCount = 0) and (NoClientsHaveConnectedYet = false)then
1629 begin
1630 Application.Terminate;
1631// SendMessage(Application.MainForm.Handle,WM_CLOSE,0,0);
1632 end;
1633end;
1634
1635// Global Function Implementation
1636function TSharedBrokerClientMgr.Piece(const S: string; Delim: char; PieceNum: Integer): string;
1637{ returns the Nth piece (PieceNum) of a string delimited by Delim }
1638var
1639 i: Integer;
1640 Strt, Next: PChar;
1641begin
1642 i := 1;
1643 Strt := PChar(S);
1644 Next := StrScan(Strt, Delim);
1645 while (i < PieceNum) and (Next <> nil) do
1646 begin
1647 Inc(i);
1648 Strt := Next + 1;
1649 Next := StrScan(Strt, Delim);
1650 end;
1651 if Next = nil then Next := StrEnd(Strt);
1652 if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt);
1653end;
1654
1655constructor RPCCallHistoryEntry.Create;
1656begin
1657 CallName := kNoneString;
1658 CallParams := kNoneString;
1659 CallResults := kNoneString;
1660 CallStartDateTime := 0;
1661 CallDurationInMS := 0;
1662end;
1663
1664
1665constructor RPCCallHistoryEntry.Create(context:WideString;
1666 name:WideString;
1667 params:WideString;
1668 results:WideString;
1669 startDateTime:Double;
1670 durationInMS:Longword;
1671 clientId:Integer);
1672begin;
1673 CallContext := context;
1674 CallName := name;
1675 CallParams := params;
1676 CallResults := results;
1677 CallStartDateTime := startDateTime;
1678 CallDurationInMS := durationInMS;
1679
1680 UniqueRPCCallId := ClientMgr.GetNextRpcUniqueId;
1681
1682 BrokerUniqueClientId := clientId;
1683end;
1684
1685constructor RPCCallHistory.Create;
1686begin
1687 inherited;
1688 FEnabled := kRpcCallHistoryEnabledDefault;
1689end;
1690
1691function RPCCallHistory.Add(entry: RPCCallHistoryEntry): Integer;
1692var
1693 diff,i,limit: integer;
1694begin
1695 // Don't put critical sections around these ClientMgr accesses since
1696 // this call is most often nested
1697 Result := -1;
1698 if (Enabled = True) then
1699 begin
1700 limit := ClientMgr.PerClientRpcHistoryLimit;
1701 if (Count > limit ) then
1702 begin
1703 // This could happen since a client may reduce the max number
1704 // of history entries on the fly and it may be less than what is
1705 // already recorded.
1706 diff := ClientMgr.PerClientRpcHistoryLimit - Count;
1707 for i:=1 to diff do Delete(Count-1); // Delete the extras
1708 end else if (Count <= limit) then
1709 begin
1710 // If the history is full then delete the first one.
1711 // The latest is added to the back
1712 if (Count = limit) and (limit > 0) then Delete(0);
1713
1714 Result := Add(Pointer(entry));
1715 Assert(Result <> -1);
1716 end;
1717 end;
1718end;
1719
1720function RPCCallHistory.GetRPCCallEntryPtr(uniqueRpcId:Longword;
1721 out rpcEntryPtr:RPCCallHistoryEntryPointer)
1722 : ISharedBrokerErrorCode;
1723var
1724 i,entryCount:integer;
1725 item: RPCCallHistoryEntry;
1726begin
1727 Result := UniqueRPCIdDoesNotExist;
1728 rpcEntryPtr := nil;
1729
1730 entryCount := Pred(Count);
1731
1732 for i:=0 to entryCount do
1733 begin
1734 item := RPCCallHistoryEntry(self[i]);
1735 if item <> nil then
1736 begin
1737 if item.UniqueRPCCallId = uniqueRpcId then
1738 begin
1739 rpcEntryPtr := @item;
1740 Result := Success;
1741 // We found one so exit the routine
1742 Exit;
1743 end;
1744 end;
1745 end;
1746end;
1747
1748function RPCCallHistory.GetRPCCallEntryPtrFromIndex(rpcCallIndex:Integer;
1749 out rpcEntryPtr:RPCCallHistoryEntryPointer)
1750 : ISharedBrokerErrorCode;
1751begin
1752 rpcEntryPtr := nil;
1753 Result := RPCHistoryIndexOutOfRange;
1754
1755 if (rpcCallIndex > 0) and (rpcCallIndex <= Count) then
1756 begin
1757 rpcEntryPtr := self[rpcCallIndex];
1758 Result := Success;
1759 end;
1760end;
1761
1762function RPCCallHistory.GetRPCCallClientId(uniqueRpcId:Integer;
1763 out uniqueClientId:Integer)
1764 : ISharedBrokerErrorCode;
1765var
1766 rpcEntryPtr : RPCCallHistoryEntryPointer;
1767begin
1768 Result := GetRPCCallEntryPtr(uniqueRpcId,rpcEntryPtr);
1769 if (Result = Success) and (rpcEntryPtr <> nil)then
1770 uniqueClientId := rpcEntryPtr^.BrokerUniqueClientId
1771 else
1772 uniqueClientId := 0;
1773end;
1774
1775
1776{
1777procedure TSharedBroker.EventSinkChanged(const EventSink: IUnknown);
1778begin
1779 FEvents := EventSink as ISharedBrokerEvents;
1780 if FConnectionPoint <> nil then
1781 FSinkList := FConnectionPoint.SinkList;
1782end;
1783
1784procedure TSharedBroker.Initialize;
1785begin
1786 inherited Initialize;
1787 FConnectionPoints := TConnectionPoints.Create(Self);
1788 if AutoFactory.EventTypeInfo <> nil then
1789 FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
1790 AutoFactory.EventIID, ckSingle, EventConnect)
1791 else FConnectionPoint := nil;
1792end;
1793
1794
1795function TSharedBroker.BrokerConnect(const ClientName: WideString;
1796 ConnectionType: ISharedBrokerClient; const ServerPort: WideString;
1797 WantDebug, AllowShared: WordBool; RpcTimeLimit: SYSINT;
1798 out UniqueClientId: SYSINT): ISharedBrokerErrorCode;
1799begin
1800
1801end;
1802
1803function TSharedBroker.BrokerCall(const RpcName, RpcParams: WideString;
1804 RpcTimeLimit: Integer; out RpcResults: WideString;
1805 out UniqueRpcCallId: Integer): ISharedBrokerErrorCode;
1806begin
1807
1808end;
1809
1810function TSharedBroker.BrokerDisconnect: ISharedBrokerErrorCode;
1811begin
1812
1813end;
1814
1815function TSharedBroker.BrokerSetContext(
1816 const OptionName: WideString): ISharedBrokerErrorCode;
1817begin
1818
1819end;
1820
1821function TSharedBroker.ReadRegDataDefault(const Root, Key, Name,
1822 Default: WideString; out RegResult: WideString): ISharedBrokerErrorCode;
1823begin
1824
1825end;
1826
1827function TSharedBroker.Get_PerClientRpcHistoryLimit: Integer;
1828begin
1829
1830end;
1831
1832function TSharedBroker.Get_RpcHistoryEnabled: WordBool;
1833begin
1834
1835end;
1836
1837function TSharedBroker.Get_RpcVersion: WideString;
1838begin
1839
1840end;
1841
1842procedure TSharedBroker.Set_PerClientRpcHistoryLimit(limit: Integer);
1843begin
1844
1845end;
1846
1847procedure TSharedBroker.Set_RpcHistoryEnabled(enabled: WordBool);
1848begin
1849
1850end;
1851
1852procedure TSharedBroker.Set_RpcVersion(const version: WideString);
1853begin
1854
1855end;
1856
1857function TSharedBroker.GetActiveBrokerConnectionIndexCount(
1858 out connectionIndexCount: Integer): ISharedBrokerErrorCode;
1859begin
1860
1861end;
1862
1863function TSharedBroker.GetActiveBrokerConnectionIndexFromUniqueClientId(
1864 uniqueClientId: Integer;
1865 out connectionIndex: Integer): ISharedBrokerErrorCode;
1866begin
1867
1868end;
1869
1870function TSharedBroker.GetActiveBrokerConnectionInfo(
1871 connectionIndex: Integer; out connectedServerIp: WideString;
1872 out connectedServerPort: Integer;
1873 out lastContext: WideString): ISharedBrokerErrorCode;
1874begin
1875
1876end;
1877
1878function TSharedBroker.GetClientIdAndNameFromIndex(clientIndex: Integer;
1879 out uniqueClientId: Integer;
1880 out clientName: WideString): ISharedBrokerErrorCode;
1881begin
1882
1883end;
1884
1885function TSharedBroker.GetClientNameFromUniqueClientId(
1886 uniqueClientId: Integer;
1887 out clientName: WideString): ISharedBrokerErrorCode;
1888begin
1889
1890end;
1891
1892function TSharedBroker.GetRpcHistoryCountForClient(uniqueClientId: Integer;
1893 out rpcHistoryCount: Integer): ISharedBrokerErrorCode;
1894begin
1895
1896end;
1897
1898function TSharedBroker.LogoutConnectedClients(
1899 logoutTimeLimit: Integer): ISharedBrokerErrorCode;
1900begin
1901
1902end;
1903
1904function TSharedBroker.GetRpcCallFromHistoryIndex(uniqueClientId,
1905 rpcCallIndex: Integer; out uniqueRpcId: Integer; out brokerContext,
1906 rpcName, rpcParams, rpcResult: WideString; out rpcStartDateTime: Double;
1907 out rpcDuration: Integer): ISharedBrokerErrorCode;
1908begin
1909
1910end;
1911
1912function TSharedBroker.GetRpcClientIdFromHistory(uniqueRpcId: Integer;
1913 out uniqueClientId: Integer;
1914 out clientName: WideString): ISharedBrokerErrorCode;
1915begin
1916
1917end;
1918
1919function TSharedBroker.GetConnectedClientCount(
1920 out connectedClientCount: Integer): ISharedBrokerErrorCode;
1921begin
1922
1923end;
1924}
1925
1926{
1927function TSharedBroker.GetRpcCallFromHistory(uniqueRpcId: Integer;
1928 out uniqueClientId: Integer; out brokerContext, rpcName, rpcParams,
1929 rpcResult: WideString; out rpcStartDateTime: Double;
1930 out rpcDuration: Integer): ISharedBrokerErrorCode;
1931begin
1932 //
1933end;
1934}
1935function TSharedBroker.Get_CurrentContext: WideString;
1936begin
1937 if FBrokerConnection <> nil then
1938 begin
1939 Result := FBrokerConnection.FBroker.CurrentContext;
1940 end else
1941 begin
1942 // Don't know what else to make this if we don't actually have a TRPCBroker to ask
1943 Result := '';
1944 end;
1945end;
1946
1947function TSharedBroker.Get_KernelLogin: WordBool;
1948begin
1949 if FBrokerConnection <> nil then
1950 begin
1951 Result := FBrokerConnection.FBroker.KernelLogin;
1952 end else
1953 begin
1954 // Don't know what else to make this if we don't actually have a TRPCBroker to ask
1955 Result := True;
1956 end;
1957end;
1958
1959function TSharedBroker.Get_Login: WideString;
1960
1961 function TorF1(Value: Boolean): String;
1962 begin
1963 Result := '0';
1964 if Value then
1965 Result := '1';
1966 end;
1967
1968const
1969 SEP_FS = #28;
1970 SEP_GS = #29;
1971var
1972 I: Integer;
1973 Str: String;
1974 ModeVal: String;
1975 DivLst: String;
1976 MultiDiv: String;
1977 PromptDiv: String;
1978 StrFS, StrGS: String;
1979begin
1980 //TODO
1981 if FBrokerConnection <> nil then
1982 with FBrokerConnection.FBroker.Login do
1983 begin
1984 StrFS := SEP_FS;
1985 StrGS := SEP_GS;
1986 ModeVal := '';
1987 if Mode = lmAVCodes then
1988 ModeVal := '1'
1989 else if Mode = lmAppHandle then
1990 ModeVal := '2'
1991 else if Mode = lmNTToken then
1992 ModeVal := '3';
1993 DivLst := '';
1994 for i := 0 to Pred(DivList.Count) do
1995 DivLst := DivLst + DivList[i] + SEP_GS;
1996 MultiDiv := TorF1(MultiDivision);
1997 PromptDiv := TorF1(PromptDivision);
1998 Str := LoginHandle + StrFS + NTToken + StrFS + AccessCode + StrFS;
1999 Str := Str + VerifyCode + StrFS + Division + StrFS + ModeVal + StrFS;
2000 Str := Str + DivLst + StrFS + MultiDiv + StrFS + DUZ + StrFS;
2001 Str := Str + PromptDiv + StrFS;
2002 end; // with
2003end;
2004
2005function TSharedBroker.Get_RpcbError: WideString;
2006begin
2007 if FBrokerConnection <> nil then
2008 begin
2009 Result := FBrokerConnection.FBroker.RPCBError;
2010 end else
2011 begin
2012 // Don't know what else to make this if we don't actually have a TRPCBroker to ask
2013 Result := '';
2014 end;
2015end;
2016
2017function TSharedBroker.Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs;
2018begin
2019 Result := isemRaise;
2020 if FBrokerConnection <> nil then
2021 if FBrokerConnection.FBroker.ShowErrorMsgs = semQuiet then
2022 Result := isemQuiet;
2023end;
2024
2025function TSharedBroker.Get_Socket: Integer;
2026begin
2027 Result := 0;
2028 if FBrokerConnection <> nil then
2029 Result := FBrokerConnection.FBroker.Socket;
2030end;
2031
2032function TSharedBroker.Get_User: WideString;
2033const
2034 SEP_FS = #28;
2035var
2036 Str: String;
2037begin
2038 Str := '';
2039 if FBrokerConnection <> nil then
2040 begin
2041 with FBrokerConnection.FBroker.User do
2042 begin
2043 Str := DUZ + SEP_FS + Name + SEP_FS + StandardName + SEP_FS;
2044 Str := Str + Division + SEP_FS;
2045 if VerifyCodeChngd then
2046 Str := Str + '1' + SEP_FS
2047 else
2048 Str := Str + '0' + SEP_FS;
2049 Str := Str + Title + SEP_FS + ServiceSection + SEP_FS;
2050 Str := Str + Language + SEP_FS + DTime + SEP_FS;
2051 end; // with
2052 end;
2053 Result := WideString(Str);
2054end;
2055
2056procedure TSharedBroker.Set_KernelLogin(Value: WordBool);
2057begin
2058 if FBrokerConnection <> nil then
2059 FBrokerConnection.FBroker.KernelLogin := Value;
2060end;
2061
2062procedure TSharedBroker.Set_Login(const Value: WideString);
2063const
2064 SEP_FS = #28;
2065 SEP_GS = #29;
2066var
2067 Str: String;
2068 StrFS, StrGS: String;
2069 DivLst: String;
2070 ModeVal: String;
2071
2072 function TorF(Value: String): Boolean;
2073 begin
2074 Result := False;
2075 if Value = '1' then
2076 Result := True;
2077 end;
2078
2079begin
2080 Str := Value;
2081 if FBrokerConnection <> nil then
2082 with FBrokerConnection.FBroker.Login do
2083 begin
2084 StrFS := SEP_FS;
2085 StrGS := SEP_GS;
2086 LoginHandle := Piece(Str,StrFS,1);
2087 NTToken := Piece(Str,StrFS,2);
2088 AccessCode := Piece(Str,StrFS,3);
2089 VerifyCode := Piece(Str,StrFS,4);
2090 Division := Piece(Str,StrFS,5);
2091 ModeVal := Piece(Str,StrFS,6);
2092 DivLst := Piece(Str,StrFS,7);
2093 MultiDivision := TorF(Piece(Str,StrFS,8));
2094 DUZ := Piece(Str,StrFS,9);
2095 PromptDivision := TorF(Piece(Str,StrFS,10));
2096 if ModeVal = '1' then
2097 Mode := lmAVCodes
2098 else if ModeVal = '2' then
2099 Mode := lmAppHandle
2100 else if ModeVal = '3' then
2101 Mode := lmNTToken;
2102 end; // with
2103end;
2104
2105procedure TSharedBroker.Set_ShowErrorMsgs(
2106 Value: ISharedBrokerShowErrorMsgs);
2107begin
2108 if FBrokerConnection <> nil then
2109 begin
2110 if Value = isemRaise then
2111 FBrokerConnection.FBroker.ShowErrorMsgs := semRaise
2112 else
2113 FBrokerConnection.FBroker.ShowErrorMsgs := semQuiet;
2114 end;
2115end;
2116
2117
2118initialization
2119 TAutoObjectFactory.Create(ComServer, TSharedBroker, Class_SharedBroker,
2120 ciMultiInstance, tmApartment);
2121 ClientMgr := TSharedBrokerClientMgr.Create();
2122 Application.OnIdle := ClientMgr.OnIdleEventHandler;
2123
2124finalization
2125 ClientMgr.Free;
2126 ClientMgr := nil;
2127end.
Note: See TracBrowser for help on using the repository browser.