source: cprs/trunk/BDK50/BDK32_P50/Source/uSharedBroker1.pas@ 1729

Last change on this file since 1729 was 1678, checked in by healthsevak, 10 years ago

Added this new version of Broker component libraries while updating the working copy to CPRS version 28
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 47 (Jun. 17, 2008))
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.