ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBServices.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (6 years, 6 months ago) by tony
File size: 65309 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 }
31 { }
32 {************************************************************************}
33
34 {
35 InterBase Express provides component interfaces to
36 functions introduced in InterBase 6.0. The Services
37 components (TIB*Service, TIBServerProperties)
38 function only if you have installed InterBase 6.0 or
39 later software, including Firebird
40 }
41
42 unit IBServices;
43
44 {$Mode Delphi}
45
46 interface
47
48 uses
49 {$IFDEF WINDOWS }
50 Windows,
51 {$ELSE}
52 unix,
53 {$ENDIF}
54 SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
55 IBDialogs, IBHeader, IB, IBExternals;
56
57 const
58 DefaultBufferSize = 32000;
59
60 SPBPrefix = 'isc_spb_';
61 SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
62 'user_name',
63 'sys_user_name',
64 'sys_user_name_enc',
65 'password',
66 'password_enc',
67 'command_line',
68 'db_name',
69 'verbose',
70 'options',
71 'connect_timeout',
72 'dummy_packet_interval',
73 'sql_role_name'
74 );
75
76 SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
77 isc_spb_user_name_mapped_to_server,
78 isc_spb_sys_user_name_mapped_to_server,
79 isc_spb_sys_user_name_enc_mapped_to_server,
80 isc_spb_password_mapped_to_server,
81 isc_spb_password_enc_mapped_to_server,
82 isc_spb_command_line_mapped_to_server,
83 isc_spb_dbname_mapped_to_server,
84 isc_spb_verbose_mapped_to_server,
85 isc_spb_options_mapped_to_server,
86 isc_spb_connect_timeout_mapped_to_server,
87 isc_spb_dummy_packet_interval_mapped_to_server,
88 isc_spb_sql_role_name_mapped_to_server
89 );
90
91 type
92 TProtocol = (TCP, SPX, NamedPipe, Local);
93 TOutputBufferOption = (ByLine, ByChunk);
94
95 TIBCustomService = class;
96
97 TLoginEvent = procedure(Database: TIBCustomService;
98 LoginParams: TStrings) of object;
99
100 TIBCustomService = class(TComponent)
101 private
102 FIBLoaded: Boolean;
103 FParamsChanged : Boolean;
104 FSPB, FQuerySPB : PChar;
105 FSPBLength, FQuerySPBLength : Short;
106 FTraceFlags: TTraceFlags;
107 FOnLogin: TLoginEvent;
108 FLoginPrompt: Boolean;
109 FBufferSize: Integer;
110 FOutputBuffer: PChar;
111 FQueryParams: String;
112 FServerName: string;
113 FHandle: TISC_SVC_HANDLE;
114 FStreamedActive : Boolean;
115 FOnAttach: TNotifyEvent;
116 FOutputBufferOption: TOutputBufferOption;
117 FProtocol: TProtocol;
118 FParams: TStrings;
119 function GetActive: Boolean;
120 function GetServiceParamBySPB(const Idx: Integer): String;
121 procedure SetActive(const Value: Boolean);
122 procedure SetBufferSize(const Value: Integer);
123 procedure SetParams(const Value: TStrings);
124 procedure SetServerName(const Value: string);
125 procedure SetProtocol(const Value: TProtocol);
126 procedure SetServiceParamBySPB(const Idx: Integer;
127 const Value: String);
128 function IndexOfSPBConst(st: String): Integer;
129 procedure ParamsChange(Sender: TObject);
130 procedure ParamsChanging(Sender: TObject);
131 procedure CheckServerName;
132 function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
133 function ParseString(var RunLen: Integer): string;
134 function ParseInteger(var RunLen: Integer): Integer;
135 procedure GenerateSPB(sl: TStrings; var SPB: String; var SPBLength: Short);
136
137 protected
138 procedure Loaded; override;
139 function Login: Boolean;
140 procedure CheckActive;
141 procedure CheckInactive;
142 property OutputBuffer : PChar read FOutputBuffer;
143 property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
144 property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
145 procedure InternalServiceQuery;
146 property ServiceQueryParams: String read FQueryParams write FQueryParams;
147
148 public
149 constructor Create(AOwner: TComponent); override;
150 destructor Destroy; override;
151 procedure Attach;
152 procedure Detach;
153 property Handle: TISC_SVC_HANDLE read FHandle;
154 property ServiceParamBySPB[const Idx: Integer]: String read GetServiceParamBySPB
155 write SetServiceParamBySPB;
156 published
157 property Active: Boolean read GetActive write SetActive default False;
158 property ServerName: string read FServerName write SetServerName;
159 property Protocol: TProtocol read FProtocol write SetProtocol default Local;
160 property Params: TStrings read FParams write SetParams;
161 property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default True;
162 property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
163 property OnAttach: TNotifyEvent read FOnAttach write FOnAttach;
164 property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
165 end;
166
167 TDatabaseInfo = class
168 public
169 NoOfAttachments: Integer;
170 NoOfDatabases: Integer;
171 DbName: array of string;
172 constructor Create;
173 destructor Destroy; override;
174 end;
175
176 TLicenseInfo = class
177 public
178 Key: array of string;
179 Id: array of string;
180 Desc: array of string;
181 LicensedUsers: Integer;
182 constructor Create;
183 destructor Destroy; override;
184 end;
185
186 TLicenseMaskInfo = class
187 public
188 LicenseMask: Integer;
189 CapabilityMask: Integer;
190 end;
191
192 TConfigFileData = class
193 public
194 ConfigFileValue: array of integer;
195 ConfigFileKey: array of integer;
196 constructor Create;
197 destructor Destroy; override;
198 end;
199
200 TConfigParams = class
201 public
202 ConfigFileData: TConfigFileData;
203 ConfigFileParams: array of string;
204 BaseLocation: string;
205 LockFileLocation: string;
206 MessageFileLocation: string;
207 SecurityDatabaseLocation: string;
208 constructor Create;
209 destructor Destroy; override;
210 end;
211
212 TVersionInfo = class
213 ServerVersion: String;
214 ServerImplementation: string;
215 ServiceVersion: Integer;
216 end;
217
218 TPropertyOption = (Database, License, LicenseMask, ConfigParameters, Version);
219 TPropertyOptions = set of TPropertyOption;
220
221 TIBServerProperties = class(TIBCustomService)
222 private
223 FOptions: TPropertyOptions;
224 FDatabaseInfo: TDatabaseInfo;
225 FLicenseInfo: TLicenseInfo;
226 FLicenseMaskInfo: TLicenseMaskInfo;
227 FVersionInfo: TVersionInfo;
228 FConfigParams: TConfigParams;
229 procedure ParseConfigFileData(var RunLen: Integer);
230 public
231 constructor Create(AOwner: TComponent); override;
232 destructor Destroy; override;
233 procedure Fetch;
234 procedure FetchDatabaseInfo;
235 procedure FetchLicenseInfo;
236 procedure FetchLicenseMaskInfo;
237 procedure FetchConfigParams;
238 procedure FetchVersionInfo;
239 property DatabaseInfo: TDatabaseInfo read FDatabaseInfo;
240 property LicenseInfo: TLicenseInfo read FLicenseInfo;
241 property LicenseMaskInfo: TLicenseMaskInfo read FLicenseMaskInfo;
242 property VersionInfo: TVersionInfo read FVersionInfo;
243 property ConfigParams: TConfigParams read FConfigParams;
244 published
245 property Options : TPropertyOptions read FOptions write FOptions;
246 end;
247
248 TIBControlService = class (TIBCustomService)
249 private
250 FStartParams: String;
251 FStartSPB: PChar;
252 FStartSPBLength: Integer;
253 function GetIsServiceRunning: Boolean;
254 protected
255 property ServiceStartParams: String read FStartParams write FStartParams;
256 procedure SetServiceStartOptions; virtual;
257 procedure ServiceStartAddParam (Value: string; param: Integer); overload;
258 procedure ServiceStartAddParam (Value: Integer; param: Integer); overload;
259 procedure InternalServiceStart;
260
261 public
262 constructor Create(AOwner: TComponent); override;
263 procedure ServiceStart; virtual;
264 property IsServiceRunning : Boolean read GetIsServiceRunning;
265 end;
266
267 TIBControlAndQueryService = class (TIBControlService)
268 private
269 FEof: Boolean;
270 FAction: Integer;
271 procedure SetAction(Value: Integer);
272 protected
273 property Action: Integer read FAction write SetAction;
274 public
275 constructor create (AOwner: TComponent); override;
276 function GetNextLine : String;
277 function GetNextChunk : String;
278 property Eof: boolean read FEof;
279 published
280 property BufferSize;
281 end;
282
283 TShutdownMode = (Forced, DenyTransaction, DenyAttachment);
284
285 TIBConfigService = class(TIBControlService)
286 private
287 FDatabaseName: string;
288 procedure SetDatabaseName(const Value: string);
289 protected
290
291 public
292 procedure ServiceStart; override;
293 procedure ShutdownDatabase (Options: TShutdownMode; Wait: Integer);
294 procedure SetSweepInterval (Value: Integer);
295 procedure SetDBSqlDialect (Value: Integer);
296 procedure SetPageBuffers (Value: Integer);
297 procedure ActivateShadow;
298 procedure BringDatabaseOnline;
299 procedure SetReserveSpace (Value: Boolean);
300 procedure SetAsyncMode (Value: Boolean);
301 procedure SetReadOnly (Value: Boolean);
302 published
303 property DatabaseName: string read FDatabaseName write SetDatabaseName;
304 end;
305
306 TIBLogService = class(TIBControlAndQueryService)
307 private
308
309 protected
310 procedure SetServiceStartOptions; override;
311 public
312 published
313 end;
314
315 TStatOption = (DataPages, DbLog, HeaderPages, IndexPages, SystemRelations);
316 TStatOptions = set of TStatOption;
317
318 TIBStatisticalService = class(TIBControlAndQueryService)
319 private
320 FDatabaseName: string;
321 FOptions: TStatOptions;
322 procedure SetDatabaseName(const Value: string);
323 protected
324 procedure SetServiceStartOptions; override;
325 public
326 published
327 property DatabaseName: string read FDatabaseName write SetDatabaseName;
328 property Options : TStatOptions read FOptions write FOptions;
329 end;
330
331
332 TIBBackupRestoreService = class(TIBControlAndQueryService)
333 private
334 FVerbose: Boolean;
335 protected
336 public
337 published
338 property Verbose : Boolean read FVerbose write FVerbose default False;
339 end;
340
341 TBackupOption = (IgnoreChecksums, IgnoreLimbo, MetadataOnly, NoGarbageCollection,
342 OldMetadataDesc, NonTransportable, ConvertExtTables);
343 TBackupOptions = set of TBackupOption;
344
345 TIBBackupService = class (TIBBackupRestoreService)
346 private
347 FDatabaseName: string;
348 FOptions: TBackupOptions;
349 FBackupFile: TStrings;
350 FBlockingFactor: Integer;
351 procedure SetBackupFile(const Value: TStrings);
352 protected
353 procedure SetServiceStartOptions; override;
354 public
355 constructor Create(AOwner: TComponent); override;
356 destructor Destroy; override;
357
358 published
359 { a name=value pair of filename and length }
360 property BackupFile: TStrings read FBackupFile write SetBackupFile;
361 property BlockingFactor: Integer read FBlockingFactor write FBlockingFactor;
362 property DatabaseName: string read FDatabaseName write FDatabaseName;
363 property Options : TBackupOptions read FOptions write FOptions;
364 end;
365
366 TRestoreOption = (DeactivateIndexes, NoShadow, NoValidityCheck, OneRelationAtATime,
367 Replace, CreateNewDB, UseAllSpace);
368
369 TRestoreOptions = set of TRestoreOption;
370 TIBRestoreService = class (TIBBackupRestoreService)
371 private
372 FDatabaseName: TStrings;
373 FBackupFile: TStrings;
374 FOptions: TRestoreOptions;
375 FPageSize: Integer;
376 FPageBuffers: Integer;
377 procedure SetBackupFile(const Value: TStrings);
378 procedure SetDatabaseName(const Value: TStrings);
379 protected
380 procedure SetServiceStartOptions; override;
381 public
382 constructor Create(AOwner: TComponent); override;
383 destructor Destroy; override;
384 published
385 { a name=value pair of filename and length }
386 property DatabaseName: TStrings read FDatabaseName write SetDatabaseName;
387 property BackupFile: TStrings read FBackupFile write SetBackupFile;
388 property PageSize: Integer read FPageSize write FPageSize;
389 property PageBuffers: Integer read FPageBuffers write FPageBuffers;
390 property Options : TRestoreOptions read FOptions write FOptions default [CreateNewDB];
391 end;
392
393 TValidateOption = (LimboTransactions, CheckDB, IgnoreChecksum, KillShadows, MendDB,
394 SweepDB, ValidateDB, ValidateFull);
395 TValidateOptions = set of TValidateOption;
396
397 TTransactionGlobalAction = (CommitGlobal, RollbackGlobal, RecoverTwoPhaseGlobal,
398 NoGlobalAction);
399 TTransactionState = (LimboState, CommitState, RollbackState, UnknownState);
400 TTransactionAdvise = (CommitAdvise, RollbackAdvise, UnknownAdvise);
401 TTransactionAction = (CommitAction, RollbackAction);
402
403 TLimboTransactionInfo = class
404 public
405 MultiDatabase: Boolean;
406 ID: Integer;
407 HostSite: String;
408 RemoteSite: String;
409 RemoteDatabasePath: String;
410 State: TTransactionState;
411 Advise: TTransactionAdvise;
412 Action: TTransactionAction;
413 end;
414
415 TIBValidationService = class(TIBControlAndQueryService)
416 private
417 FDatabaseName: string;
418 FOptions: TValidateOptions;
419 FLimboTransactionInfo: array of TLimboTransactionInfo;
420 FGlobalAction: TTransactionGlobalAction;
421 procedure SetDatabaseName(const Value: string);
422 function GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
423 function GetLimboTransactionInfoCount: integer;
424
425 protected
426 procedure SetServiceStartOptions; override;
427 public
428 constructor Create(AOwner: TComponent); override;
429 destructor Destroy; override;
430 procedure FetchLimboTransactionInfo;
431 procedure FixLimboTransactionErrors;
432 property LimboTransactionInfo[Index: integer]: TLimboTransactionInfo read GetLimboTransactionInfo;
433 property LimboTransactionInfoCount: Integer read GetLimboTransactionInfoCount;
434
435 published
436 property DatabaseName: string read FDatabaseName write SetDatabaseName;
437 property Options: TValidateOptions read FOptions write FOptions;
438 property GlobalAction: TTransactionGlobalAction read FGlobalAction
439 write FGlobalAction;
440 end;
441
442 TUserInfo = class
443 public
444 UserName: string;
445 FirstName: string;
446 MiddleName: string;
447 LastName: string;
448 GroupID: Integer;
449 UserID: Integer;
450 end;
451
452 TSecurityAction = (ActionAddUser, ActionDeleteUser, ActionModifyUser, ActionDisplayUser);
453 TSecurityModifyParam = (ModifyFirstName, ModifyMiddleName, ModifyLastName, ModifyUserId,
454 ModifyGroupId, ModifyPassword);
455 TSecurityModifyParams = set of TSecurityModifyParam;
456
457 TIBSecurityService = class(TIBControlAndQueryService)
458 private
459 FUserID: Integer;
460 FGroupID: Integer;
461 FFirstName: string;
462 FUserName: string;
463 FPassword: string;
464 FSQLRole: string;
465 FLastName: string;
466 FMiddleName: string;
467 FUserInfo: array of TUserInfo;
468 FSecurityAction: TSecurityAction;
469 FModifyParams: TSecurityModifyParams;
470 procedure ClearParams;
471 procedure SetSecurityAction (Value: TSecurityAction);
472 procedure SetFirstName (Value: String);
473 procedure SetMiddleName (Value: String);
474 procedure SetLastName (Value: String);
475 procedure SetPassword (Value: String);
476 procedure SetUserId (Value: Integer);
477 procedure SetGroupId (Value: Integer);
478
479 procedure FetchUserInfo;
480 function GetUserInfo(Index: Integer): TUserInfo;
481 function GetUserInfoCount: Integer;
482
483 protected
484 procedure Loaded; override;
485 procedure SetServiceStartOptions; override;
486 public
487 constructor Create(AOwner: TComponent); override;
488 destructor Destroy; override;
489 procedure DisplayUsers;
490 procedure DisplayUser(UserName: string);
491 procedure AddUser;
492 procedure DeleteUser;
493 procedure ModifyUser;
494 property UserInfo[Index: Integer]: TUserInfo read GetUserInfo;
495 property UserInfoCount: Integer read GetUserInfoCount;
496
497 published
498 property SecurityAction: TSecurityAction read FSecurityAction
499 write SetSecurityAction;
500 property SQlRole : string read FSQLRole write FSQLrole;
501 property UserName : string read FUserName write FUserName;
502 property FirstName : string read FFirstName write SetFirstName;
503 property MiddleName : string read FMiddleName write SetMiddleName;
504 property LastName : string read FLastName write SetLastName;
505 property UserID : Integer read FUserID write SetUserID;
506 property GroupID : Integer read FGroupID write SetGroupID;
507 property Password : string read FPassword write setPassword;
508 end;
509
510
511 implementation
512
513 uses
514 IBIntf , IBSQLMonitor, Math;
515
516 { TIBCustomService }
517
518 procedure TIBCustomService.Attach;
519 var
520 SPB: String;
521 ConnectString: String;
522 begin
523 CheckInactive;
524 CheckServerName;
525
526 if FLoginPrompt and not Login then
527 IBError(ibxeOperationCancelled, [nil]);
528
529 { Generate a new SPB if necessary }
530 if FParamsChanged then
531 begin
532 FParamsChanged := False;
533 GenerateSPB(FParams, SPB, FSPBLength);
534 IBAlloc(FSPB, 0, FsPBLength);
535 Move(SPB[1], FSPB[0], FSPBLength);
536 end;
537 case FProtocol of
538 TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
539 SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
540 NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
541 Local: ConnectString := 'service_mgr'; {do not localize}
542 end;
543 if call(isc_service_attach(StatusVector, Length(ConnectString),
544 PChar(ConnectString), @FHandle,
545 FSPBLength, FSPB), False) > 0 then
546 begin
547 FHandle := nil;
548 IBDataBaseError;
549 end;
550
551 if Assigned(FOnAttach) then
552 FOnAttach(Self);
553
554 MonitorHook.ServiceAttach(Self);
555 end;
556
557 procedure TIBCustomService.Loaded;
558 begin
559 inherited Loaded;
560 try
561 if FStreamedActive and (not Active) then
562 Attach;
563 except
564 if csDesigning in ComponentState then
565 Application.HandleException(Self)
566 else
567 raise;
568 end;
569 end;
570
571 function TIBCustomService.Login: Boolean;
572 var
573 IndexOfUser, IndexOfPassword: Integer;
574 Username, Password: String;
575 LoginParams: TStrings;
576 begin
577 if Assigned(FOnLogin) then begin
578 result := True;
579 LoginParams := TStringList.Create;
580 try
581 LoginParams.Assign(Params);
582 FOnLogin(Self, LoginParams);
583 Params.Assign (LoginParams);
584 finally
585 LoginParams.Free;
586 end;
587 end
588 else begin
589 IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
590 if IndexOfUser <> -1 then
591 Username := Copy(Params[IndexOfUser],
592 Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
593 Length(Params[IndexOfUser]));
594 IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
595 if IndexOfPassword <> -1 then
596 Password := Copy(Params[IndexOfPassword],
597 Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
598 Length(Params[IndexOfPassword]));
599 result := ServerLoginDialog(serverName, Username, Password);
600 if result then
601 begin
602 IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
603 if IndexOfUser = -1 then
604 Params.Add(SPBConstantNames[isc_spb_user_name] + '=' + Username)
605 else
606 Params[IndexOfUser] := SPBConstantNames[isc_spb_user_name] +
607 '=' + Username;
608 if IndexOfPassword = -1 then
609 Params.Add(SPBConstantNames[isc_spb_password] + '=' + Password)
610 else
611 Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
612 '=' + Password;
613 end;
614 end;
615 end;
616
617 procedure TIBCustomService.CheckActive;
618 begin
619 if FStreamedActive and (not Active) then
620 Loaded;
621 if FHandle = nil then
622 IBError(ibxeServiceActive, [nil]);
623 end;
624
625 procedure TIBCustomService.CheckInactive;
626 begin
627 if FHandle <> nil then
628 IBError(ibxeServiceInActive, [nil]);
629 end;
630
631 constructor TIBCustomService.Create(AOwner: TComponent);
632 begin
633 inherited Create(AOwner);
634 FIBLoaded := False;
635 CheckIBLoaded;
636 FIBLoaded := True;
637 FserverName := '';
638 FParams := TStringList.Create;
639 FParamsChanged := True;
640 TStringList(FParams).OnChange := ParamsChange;
641 TStringList(FParams).OnChanging := ParamsChanging;
642 FSPB := nil;
643 FQuerySPB := nil;
644 FBufferSize := DefaultBufferSize;
645 FHandle := nil;
646 FLoginPrompt := True;
647 FTraceFlags := [];
648 FOutputbuffer := nil;
649 FProtocol := Local;
650 end;
651
652 destructor TIBCustomService.Destroy;
653 begin
654 if FIBLoaded then
655 begin
656 if FHandle <> nil then
657 Detach;
658 FreeMem(FSPB);
659 FSPB := nil;
660 FParams.Free;
661 end;
662 ReallocMem(FOutputBuffer, 0);
663 inherited Destroy;
664 end;
665
666 procedure TIBCustomService.Detach;
667 begin
668 CheckActive;
669 if (Call(isc_service_detach(StatusVector, @FHandle), False) > 0) then
670 begin
671 FHandle := nil;
672 IBDataBaseError;
673 end
674 else
675 FHandle := nil;
676 MonitorHook.ServiceDetach(Self);
677 end;
678
679 function TIBCustomService.GetActive: Boolean;
680 begin
681 result := FHandle <> nil;
682 end;
683
684 function TIBCustomService.GetServiceParamBySPB(const Idx: Integer): String;
685 var
686 ConstIdx, EqualsIdx: Integer;
687 begin
688 if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
689 begin
690 ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
691 if ConstIdx = -1 then
692 result := ''
693 else
694 begin
695 result := Params[ConstIdx];
696 EqualsIdx := Pos('=', result); {mbcs ok}
697 if EqualsIdx = 0 then
698 result := ''
699 else
700 result := Copy(result, EqualsIdx + 1, Length(result));
701 end;
702 end
703 else
704 result := '';
705 end;
706
707 procedure TIBCustomService.InternalServiceQuery;
708 begin
709 FQuerySPBLength := Length(FQueryParams);
710 if FQuerySPBLength = 0 then
711 IBError(ibxeQueryParamsError, [nil]);
712 IBAlloc(FQuerySPB, 0, FQuerySPBLength);
713 Move(FQueryParams[1], FQuerySPB[0], FQuerySPBLength);
714 if (FOutputBuffer = nil) then
715 IBAlloc(FOutputBuffer, 0, FBufferSize);
716 try
717 if call(isc_service_query(StatusVector, @FHandle, nil, 0, nil,
718 FQuerySPBLength, FQuerySPB,
719 FBufferSize, FOutputBuffer), False) > 0 then
720 begin
721 FHandle := nil;
722 IBDataBaseError;
723 end;
724 finally
725 FreeMem(FQuerySPB);
726 FQuerySPB := nil;
727 FQuerySPBLength := 0;
728 FQueryParams := '';
729 end;
730 MonitorHook.ServiceQuery(Self);
731 end;
732
733 procedure TIBCustomService.SetActive(const Value: Boolean);
734 begin
735 if csReading in ComponentState then
736 FStreamedActive := Value
737 else
738 if Value <> Active then
739 if Value then
740 Attach
741 else
742 Detach;
743 end;
744
745 procedure TIBCustomService.SetBufferSize(const Value: Integer);
746 begin
747 if (FOutputBuffer <> nil) and (Value <> FBufferSize) then
748 IBAlloc(FOutputBuffer, 0, FBufferSize);
749 end;
750
751 procedure TIBCustomService.SetParams(const Value: TStrings);
752 begin
753 FParams.Assign(Value);
754 end;
755
756 procedure TIBCustomService.SetServerName(const Value: string);
757 begin
758 if FServerName <> Value then
759 begin
760 CheckInactive;
761 FServerName := Value;
762 end;
763 end;
764
765 procedure TIBCustomService.SetProtocol(const Value: TProtocol);
766 begin
767 if FProtocol <> Value then
768 begin
769 CheckInactive;
770 FProtocol := Value;
771 if (Value = Local) then
772 FServerName := '';
773 end;
774 end;
775
776 procedure TIBCustomService.SetServiceParamBySPB(const Idx: Integer;
777 const Value: String);
778 var
779 ConstIdx: Integer;
780 begin
781 ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
782 if (Value = '') then
783 begin
784 if ConstIdx <> -1 then
785 Params.Delete(ConstIdx);
786 end
787 else
788 begin
789 if (ConstIdx = -1) then
790 Params.Add(SPBConstantNames[Idx] + '=' + Value)
791 else
792 Params[ConstIdx] := SPBConstantNames[Idx] + '=' + Value;
793 end;
794 end;
795
796 function TIBCustomService.IndexOfSPBConst(st: String): Integer;
797 var
798 i, pos_of_str: Integer;
799 begin
800 result := -1;
801 for i := 0 to Params.Count - 1 do
802 begin
803 pos_of_str := Pos(st, Params[i]); {mbcs ok}
804 if (pos_of_str = 1) or (pos_of_str = Length(SPBPrefix) + 1) then
805 begin
806 result := i;
807 break;
808 end;
809 end;
810 end;
811
812 procedure TIBCustomService.ParamsChange(Sender: TObject);
813 begin
814 FParamsChanged := True;
815 end;
816
817 procedure TIBCustomService.ParamsChanging(Sender: TObject);
818 begin
819 CheckInactive;
820 end;
821
822 procedure TIBCustomService.CheckServerName;
823 begin
824 if (FServerName = '') and (FProtocol <> Local) then
825 IBError(ibxeServerNameMissing, [nil]);
826 end;
827
828 function TIBCustomService.Call(ErrCode: ISC_STATUS;
829 RaiseError: Boolean): ISC_STATUS;
830 begin
831 result := ErrCode;
832 if RaiseError and (ErrCode > 0) then
833 IBDataBaseError;
834 end;
835
836 function TIBCustomService.ParseString(var RunLen: Integer): string;
837 var
838 Len: UShort;
839 tmp: Char;
840 begin
841 Len := isc_vax_integer(OutputBuffer + RunLen, 2);
842 RunLen := RunLen + 2;
843 if (Len <> 0) then
844 begin
845 tmp := OutputBuffer[RunLen + Len];
846 OutputBuffer[RunLen + Len] := #0;
847 result := String(PChar(@OutputBuffer[RunLen]));
848 OutputBuffer[RunLen + Len] := tmp;
849 RunLen := RunLen + Len;
850 end
851 else
852 result := '';
853 end;
854
855 function TIBCustomService.ParseInteger(var RunLen: Integer): Integer;
856 begin
857 result := isc_vax_integer(OutputBuffer + RunLen, 4);
858 RunLen := RunLen + 4;
859 end;
860
861 {
862 * GenerateSPB -
863 * Given a string containing a textual representation
864 * of the Service parameters, generate a service
865 * parameter buffer, and return it and its length
866 * in SPB and SPBLength, respectively.
867 }
868 procedure TIBCustomService.GenerateSPB(sl: TStrings; var SPB: String;
869 var SPBLength: Short);
870 var
871 i, j, SPBVal, SPBServerVal: UShort;
872 param_name, param_value: String;
873 begin
874 { The SPB is initially empty, with the exception that
875 the SPB version must be the first byte of the string.
876 }
877 SPBLength := 2;
878 SPB := Char(isc_spb_version);
879 SPB := SPB + Char(isc_spb_current_version);
880 { Iterate through the textual service parameters, constructing
881 a SPB on-the-fly }
882 for i := 0 to sl.Count - 1 do
883 begin
884 { Get the parameter's name and value from the list,
885 and make sure that the name is all lowercase with
886 no leading 'isc_spb_' prefix }
887 if (Trim(sl.Names[i]) = '') then continue;
888 param_name := LowerCase(sl.Names[i]); {mbcs ok}
889 param_value := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
890 if (Pos(SPBPrefix, param_name) = 1) then {mbcs ok}
891 Delete(param_name, 1, Length(SPBPrefix));
892 { We want to translate the parameter name to some integer
893 value. We do this by scanning through a list of known
894 service parameter names (SPBConstantNames, defined above). }
895 SPBVal := 0;
896 SPBServerVal := 0;
897 { Find the parameter }
898 for j := 1 to isc_spb_last_spb_constant do
899 if (param_name = SPBConstantNames[j]) then
900 begin
901 SPBVal := j;
902 SPBServerVal := SPBConstantValues[j];
903 break;
904 end;
905 case SPBVal of
906 isc_spb_user_name, isc_spb_password:
907 begin
908 SPB := SPB +
909 Char(SPBServerVal) +
910 Char(Length(param_value)) +
911 param_value;
912 Inc(SPBLength, 2 + Length(param_value));
913 end;
914 else
915 begin
916 if (SPBVal > 0) and
917 (SPBVal <= isc_dpb_last_dpb_constant) then
918 IBError(ibxeSPBConstantNotSupported,
919 [SPBConstantNames[SPBVal]])
920 else
921 IBError(ibxeSPBConstantUnknown, [SPBVal]);
922 end;
923 end;
924 end;
925 end;
926
927 { TIBServerProperties }
928 constructor TIBServerProperties.Create(AOwner: TComponent);
929 begin
930 inherited Create(AOwner);
931 FDatabaseInfo := TDatabaseInfo.Create;
932 FLicenseInfo := TLicenseInfo.Create;
933 FLicenseMaskInfo := TLicenseMaskInfo.Create;
934 FVersionInfo := TVersionInfo.Create;
935 FConfigParams := TConfigParams.Create;
936 end;
937
938 destructor TIBServerProperties.Destroy;
939 begin
940 FDatabaseInfo.Free;
941 FLicenseInfo.Free;
942 FLicenseMaskInfo.Free;
943 FVersionInfo.Free;
944 FConfigParams.Free;
945 inherited Destroy;
946 end;
947
948 procedure TIBServerProperties.ParseConfigFileData(var RunLen: Integer);
949 begin
950 Inc(RunLen);
951 with FConfigParams.ConfigFileData do
952 begin
953 SetLength (ConfigFileValue, Length(ConfigFileValue)+1);
954 SetLength (ConfigFileKey, Length(ConfigFileKey)+1);
955
956 ConfigFileKey[High(ConfigFileKey)] := Integer(OutputBuffer[RunLen-1]);
957 ConfigFileValue[High(ConfigFileValue)] := ParseInteger(RunLen);
958 end;
959 end;
960
961 procedure TIBServerProperties.Fetch;
962 begin
963 if (Database in Options) then
964 FetchDatabaseInfo;
965 if (License in Options) then
966 FetchLicenseInfo;
967 if (LicenseMask in Options) then
968 FetchLicenseMaskInfo;
969 if (ConfigParameters in Options) then
970 FetchConfigParams;
971 if (Version in Options) then
972 FetchVersionInfo;
973 end;
974
975 procedure TIBServerProperties.FetchConfigParams;
976 var
977 RunLen: Integer;
978
979 begin
980 ServiceQueryParams := Char(isc_info_svc_get_config) +
981 Char(isc_info_svc_get_env) +
982 Char(isc_info_svc_get_env_lock) +
983 Char(isc_info_svc_get_env_msg) +
984 Char(isc_info_svc_user_dbpath);
985
986 InternalServiceQuery;
987 RunLen := 0;
988 While (not (Integer(OutputBuffer[RunLen]) = isc_info_end)) do
989 begin
990 case Integer(OutputBuffer[RunLen]) of
991 isc_info_svc_get_config:
992 begin
993 FConfigParams.ConfigFileData.ConfigFileKey := nil;
994 FConfigParams.ConfigFileData.ConfigFileValue := nil;
995 Inc (RunLen);
996 while (not (Integer(OutputBuffer[RunLen]) = isc_info_flag_end)) do
997 ParseConfigFileData (RunLen);
998 if (Integer(OutputBuffer[RunLen]) = isc_info_flag_end) then
999 Inc (RunLen);
1000 end;
1001
1002 isc_info_svc_get_env:
1003 begin
1004 Inc (RunLen);
1005 FConfigParams.BaseLocation := ParseString(RunLen);
1006 end;
1007
1008 isc_info_svc_get_env_lock:
1009 begin
1010 Inc (RunLen);
1011 FConfigParams.LockFileLocation := ParseString(RunLen);
1012 end;
1013
1014 isc_info_svc_get_env_msg:
1015 begin
1016 Inc (RunLen);
1017 FConfigParams.MessageFileLocation := ParseString(RunLen);
1018 end;
1019
1020 isc_info_svc_user_dbpath:
1021 begin
1022 Inc (RunLen);
1023 FConfigParams.SecurityDatabaseLocation := ParseString(RunLen);
1024 end;
1025 else
1026 IBError(ibxeOutputParsingError, [nil]);
1027 end;
1028 end;
1029 end;
1030
1031 procedure TIBServerProperties.FetchDatabaseInfo;
1032 var
1033 i, RunLen: Integer;
1034 begin
1035 ServiceQueryParams := Char(isc_info_svc_svr_db_info);
1036 InternalServiceQuery;
1037 if (OutputBuffer[0] <> Char(isc_info_svc_svr_db_info)) then
1038 IBError(ibxeOutputParsingError, [nil]);
1039 RunLen := 1;
1040 if (OutputBuffer[RunLen] <> Char(isc_spb_num_att)) then
1041 IBError(ibxeOutputParsingError, [nil]);
1042 Inc(RunLen);
1043 FDatabaseInfo.NoOfAttachments := ParseInteger(RunLen);
1044 if (OutputBuffer[RunLen] <> Char(isc_spb_num_db)) then
1045 IBError(ibxeOutputParsingError, [nil]);
1046 Inc(RunLen);
1047 FDatabaseInfo.NoOfDatabases := ParseInteger(RunLen);
1048 FDatabaseInfo.DbName := nil;
1049 SetLength(FDatabaseInfo.DbName, FDatabaseInfo.NoOfDatabases);
1050 i := 0;
1051 while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
1052 begin
1053 if (OutputBuffer[RunLen] <> Char(SPBConstantValues[isc_spb_dbname])) then
1054 IBError(ibxeOutputParsingError, [nil]);
1055 Inc(RunLen);
1056 FDatabaseInfo.DbName[i] := ParseString(RunLen);
1057 Inc (i);
1058 end;
1059 end;
1060
1061 procedure TIBServerProperties.FetchLicenseInfo;
1062 var
1063 i, RunLen: Integer;
1064 done: Integer;
1065 begin
1066 ServiceQueryParams := Char(isc_info_svc_get_license) +
1067 Char(isc_info_svc_get_licensed_users);
1068 InternalServiceQuery;
1069 RunLen := 0;
1070 done := 0;
1071 i := 0;
1072 FLicenseInfo.key := nil;
1073 FLicenseInfo.id := nil;
1074 FLicenseInfo.desc := nil;
1075
1076 While done < 2 do begin
1077 Inc(Done);
1078 Inc(RunLen);
1079 case Integer(OutputBuffer[RunLen-1]) of
1080 isc_info_svc_get_license:
1081 begin
1082 while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
1083 begin
1084 if (i >= Length(FLicenseInfo.key)) then
1085 begin
1086 SetLength(FLicenseInfo.key, i + 10);
1087 SetLength(FLicenseInfo.id, i + 10);
1088 SetLength(FLicenseInfo.desc, i + 10);
1089 end;
1090 if (OutputBuffer[RunLen] <> Char(isc_spb_lic_id)) then
1091 IBError(ibxeOutputParsingError, [nil]);
1092 Inc(RunLen);
1093 FLicenseInfo.id[i] := ParseString(RunLen);
1094 if (OutputBuffer[RunLen] <> Char(isc_spb_lic_key)) then
1095 IBError(ibxeOutputParsingError, [nil]);
1096 Inc(RunLen);
1097 FLicenseInfo.key[i] := ParseString(RunLen);
1098 if (OutputBuffer[RunLen] <> Char(7)) then
1099 IBError(ibxeOutputParsingError, [nil]);
1100 Inc(RunLen);
1101 FLicenseInfo.desc[i] := ParseString(RunLen);
1102 Inc(i);
1103 end;
1104 Inc(RunLen);
1105 if (Length(FLicenseInfo.key) > i) then
1106 begin
1107 SetLength(FLicenseInfo.key, i);
1108 SetLength(FLicenseInfo.id, i);
1109 SetLength(FLicenseInfo.desc, i);
1110 end;
1111 end;
1112 isc_info_svc_get_licensed_users:
1113 FLicenseInfo.LicensedUsers := ParseInteger(RunLen);
1114 else
1115 IBError(ibxeOutputParsingError, [nil]);
1116 end;
1117 end;
1118 end;
1119
1120 procedure TIBServerProperties.FetchLicenseMaskInfo();
1121 var
1122 done,RunLen:integer;
1123 begin
1124 ServiceQueryParams := Char(isc_info_svc_get_license_mask) +
1125 Char(isc_info_svc_capabilities);
1126 InternalServiceQuery;
1127 RunLen := 0;
1128 done := 0;
1129 While done <= 1 do
1130 begin
1131 Inc(done);
1132 Inc(RunLen);
1133 case Integer(OutputBuffer[RunLen-1]) of
1134 isc_info_svc_get_license_mask:
1135 FLicenseMaskInfo.LicenseMask := ParseInteger(RunLen);
1136 isc_info_svc_capabilities:
1137 FLicenseMaskInfo.CapabilityMask := ParseInteger(RunLen);
1138 else
1139 IBError(ibxeOutputParsingError, [nil]);
1140 end;
1141 end;
1142 end;
1143
1144
1145 procedure TIBServerProperties.FetchVersionInfo;
1146 var
1147 RunLen: Integer;
1148 done: Integer;
1149 begin
1150 ServiceQueryParams := Char(isc_info_svc_version) +
1151 Char(isc_info_svc_server_version) +
1152 Char(isc_info_svc_implementation);
1153 InternalServiceQuery;
1154 RunLen := 0;
1155 done := 0;
1156
1157 While done <= 2 do
1158 begin
1159 Inc(done);
1160 Inc(RunLen);
1161 case Integer(OutputBuffer[RunLen-1]) of
1162 isc_info_svc_version:
1163 FVersionInfo.ServiceVersion := ParseInteger(RunLen);
1164 isc_info_svc_server_version:
1165 FVersionInfo.ServerVersion := ParseString(RunLen);
1166 isc_info_svc_implementation:
1167 FVersionInfo.ServerImplementation := ParseString(RunLen);
1168 else
1169 IBError(ibxeOutputParsingError, [nil]);
1170 end;
1171 end;
1172 end;
1173
1174 { TIBControlService }
1175 procedure TIBControlService.SetServiceStartOptions;
1176 begin
1177
1178 end;
1179
1180 function TIBControlService.GetIsServiceRunning: Boolean;
1181 var
1182 RunLen: Integer;
1183 begin
1184 ServiceQueryParams := Char(isc_info_svc_running);
1185 InternalServiceQuery;
1186 if (OutputBuffer[0] <> Char(isc_info_svc_running)) then
1187 IBError(ibxeOutputParsingError, [nil]);
1188 RunLen := 1;
1189 if (ParseInteger(RunLen) = 1) then
1190 result := True
1191 else
1192 result := False;
1193 end;
1194
1195 procedure TIBControlService.ServiceStartAddParam (Value: string; param: Integer);
1196 var
1197 Len: UShort;
1198 begin
1199 Len := Length(Value);
1200 if Len > 0 then
1201 begin
1202 FStartParams := FStartParams +
1203 Char(Param) +
1204 PChar(@Len)[0] +
1205 PChar(@Len)[1] +
1206 Value;
1207 end;
1208 end;
1209
1210 procedure TIBControlService.ServiceStartAddParam (Value: Integer; param: Integer);
1211 begin
1212 FStartParams := FStartParams +
1213 Char(Param) +
1214 PChar(@Value)[0] +
1215 PChar(@Value)[1] +
1216 PChar(@Value)[2] +
1217 PChar(@Value)[3];
1218 end;
1219
1220 constructor TIBControlService.Create(AOwner: TComponent);
1221 begin
1222 inherited create(AOwner);
1223 FStartParams := '';
1224 FStartSPB := nil;
1225 FStartSPBLength := 0;
1226 end;
1227
1228 procedure TIBControlService.InternalServiceStart;
1229 begin
1230 FStartSPBLength := Length(FStartParams);
1231 if FStartSPBLength = 0 then
1232 IBError(ibxeStartParamsError, [nil]);
1233 IBAlloc(FStartSPB, 0, FStartSPBLength);
1234 Move(FStartParams[1], FStartSPB[0], FstartSPBLength);
1235 try
1236 if call(isc_service_start(StatusVector, @FHandle, nil,
1237 FStartSPBLength, FStartSPB), False) > 0 then
1238 begin
1239 FHandle := nil;
1240 IBDataBaseError;
1241 end;
1242 finally
1243 FreeMem(FStartSPB);
1244 FStartSPB := nil;
1245 FStartSPBLength := 0;
1246 FStartParams := '';
1247 end;
1248 MonitorHook.ServiceStart(Self);
1249 end;
1250
1251 procedure TIBControlService.ServiceStart;
1252 begin
1253 CheckActive;
1254 SetServiceStartOptions;
1255 InternalServiceStart;
1256 end;
1257
1258 { TIBConfigService }
1259
1260 procedure TIBConfigService.ServiceStart;
1261 begin
1262 IBError(ibxeUseSpecificProcedures, [nil]);
1263 end;
1264
1265 procedure TIBConfigService.ActivateShadow;
1266 begin
1267 ServiceStartParams := Char(isc_action_svc_properties);
1268 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1269 ServiceStartAddParam (isc_spb_prp_activate, SPBConstantValues[isc_spb_options]);
1270 InternalServiceStart;
1271 end;
1272
1273 procedure TIBConfigService.BringDatabaseOnline;
1274 begin
1275 ServiceStartParams := Char(isc_action_svc_properties);
1276 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1277 ServiceStartAddParam (isc_spb_prp_db_online, SPBConstantValues[isc_spb_options]);
1278 InternalServiceStart;
1279 end;
1280
1281 procedure TIBConfigService.SetAsyncMode(Value: Boolean);
1282 begin
1283 ServiceStartParams := Char(isc_action_svc_properties);
1284 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1285 ServiceStartParams := ServiceStartParams +
1286 Char(isc_spb_prp_write_mode);
1287 if Value then
1288 ServiceStartParams := ServiceStartParams +
1289 Char(isc_spb_prp_wm_async)
1290 else
1291 ServiceStartParams := ServiceStartParams +
1292 Char(isc_spb_prp_wm_sync);
1293 InternalServiceStart;
1294 end;
1295
1296 procedure TIBConfigService.SetDatabaseName(const Value: string);
1297 begin
1298 FDatabaseName := Value;
1299 end;
1300
1301 procedure TIBConfigService.SetPageBuffers(Value: Integer);
1302 begin
1303 ServiceStartParams := Char(isc_action_svc_properties);
1304 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1305 ServiceStartAddParam (Value, isc_spb_prp_page_buffers);
1306 InternalServiceStart;
1307 end;
1308
1309 procedure TIBConfigService.SetReadOnly(Value: Boolean);
1310 begin
1311 ServiceStartParams := Char(isc_action_svc_properties);
1312 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1313 ServiceStartParams := ServiceStartParams +
1314 Char(isc_spb_prp_access_mode);
1315 if Value then
1316 ServiceStartParams := ServiceStartParams +
1317 Char(isc_spb_prp_am_readonly)
1318 else
1319 ServiceStartParams := ServiceStartParams +
1320 Char(isc_spb_prp_am_readwrite);
1321 InternalServiceStart;
1322 end;
1323
1324 procedure TIBConfigService.SetReserveSpace(Value: Boolean);
1325 begin
1326 ServiceStartParams := Char(isc_action_svc_properties);
1327 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1328 ServiceStartParams := ServiceStartParams +
1329 Char(isc_spb_prp_reserve_space);
1330 if Value then
1331 ServiceStartParams := ServiceStartParams +
1332 Char(isc_spb_prp_res)
1333 else
1334 ServiceStartParams := ServiceStartParams +
1335 Char(isc_spb_prp_res_use_full);
1336 InternalServiceStart;
1337 end;
1338
1339 procedure TIBConfigService.SetSweepInterval(Value: Integer);
1340 begin
1341 ServiceStartParams := Char(isc_action_svc_properties);
1342 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1343 ServiceStartAddParam (Value, isc_spb_prp_sweep_interval);
1344 InternalServiceStart;
1345 end;
1346
1347 procedure TIBConfigService.SetDBSqlDialect(Value: Integer);
1348 begin
1349 ServiceStartParams := Char(isc_action_svc_properties);
1350 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1351 ServiceStartAddParam (Value, isc_spb_prp_set_sql_dialect);
1352 InternalServiceStart;
1353 end;
1354
1355 procedure TIBConfigService.ShutdownDatabase(Options: TShutdownMode;
1356 Wait: Integer);
1357 begin
1358 ServiceStartParams := Char(isc_action_svc_properties);
1359 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1360 if (Options = Forced) then
1361 ServiceStartAddParam (Wait, isc_spb_prp_shutdown_db)
1362 else if (Options = DenyTransaction) then
1363 ServiceStartAddParam (Wait, isc_spb_prp_deny_new_transactions)
1364 else
1365 ServiceStartAddParam (Wait, isc_spb_prp_deny_new_attachments);
1366 InternalServiceStart;
1367 end;
1368
1369 { TIBStatisticalService }
1370
1371 procedure TIBStatisticalService.SetDatabaseName(const Value: string);
1372 begin
1373 FDatabaseName := Value;
1374 end;
1375
1376 procedure TIBStatisticalService.SetServiceStartOptions;
1377 var
1378 param: Integer;
1379 begin
1380 if FDatabaseName = '' then
1381 IBError(ibxeStartParamsError, [nil]);
1382 param := 0;
1383 if (DataPages in Options) then
1384 param := param or isc_spb_sts_data_pages;
1385 if (DbLog in Options) then
1386 param := param or isc_spb_sts_db_log;
1387 if (HeaderPages in Options) then
1388 param := param or isc_spb_sts_hdr_pages;
1389 if (IndexPages in Options) then
1390 param := param or isc_spb_sts_idx_pages;
1391 if (SystemRelations in Options) then
1392 param := param or isc_spb_sts_sys_relations;
1393 Action := isc_action_svc_db_stats;
1394 ServiceStartParams := Char(isc_action_svc_db_stats);
1395 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1396 ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1397 end;
1398
1399 { TIBBackupService }
1400 procedure TIBBackupService.SetServiceStartOptions;
1401 var
1402 param, i: Integer;
1403 value: String;
1404 begin
1405 if FDatabaseName = '' then
1406 IBError(ibxeStartParamsError, [nil]);
1407 param := 0;
1408 if (IgnoreChecksums in Options) then
1409 param := param or isc_spb_bkp_ignore_checksums;
1410 if (IgnoreLimbo in Options) then
1411 param := param or isc_spb_bkp_ignore_limbo;
1412 if (MetadataOnly in Options) then
1413 param := param or isc_spb_bkp_metadata_only;
1414 if (NoGarbageCollection in Options) then
1415 param := param or isc_spb_bkp_no_garbage_collect;
1416 if (OldMetadataDesc in Options) then
1417 param := param or isc_spb_bkp_old_descriptions;
1418 if (NonTransportable in Options) then
1419 param := param or isc_spb_bkp_non_transportable;
1420 if (ConvertExtTables in Options) then
1421 param := param or isc_spb_bkp_convert;
1422 Action := isc_action_svc_backup;
1423 ServiceStartParams := Char(isc_action_svc_backup);
1424 ServiceStartAddParam(FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1425 ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
1426 if Verbose then
1427 ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
1428 if FBlockingFactor > 0 then
1429 ServiceStartAddParam(FBlockingFactor, isc_spb_bkp_factor);
1430 for i := 0 to FBackupFile.Count - 1 do
1431 begin
1432 if (Trim(FBackupFile[i]) = '') then
1433 continue;
1434 if (Pos('=', FBackupFile[i]) <> 0) then
1435 begin {mbcs ok}
1436 ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1437 value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1438 param := StrToInt(value);
1439 ServiceStartAddParam(param, isc_spb_bkp_length);
1440 end
1441 else
1442 ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
1443 end;
1444 end;
1445
1446 constructor TIBBackupService.Create(AOwner: TComponent);
1447 begin
1448 inherited Create(AOwner);
1449 FBackupFile := TStringList.Create;
1450 end;
1451
1452 destructor TIBBackupService.Destroy;
1453 begin
1454 FBackupFile.Free;
1455 inherited Destroy;
1456 end;
1457
1458 procedure TIBBackupService.SetBackupFile(const Value: TStrings);
1459 begin
1460 FBackupFile.Assign(Value);
1461 end;
1462
1463 { TIBRestoreService }
1464
1465 procedure TIBRestoreService.SetServiceStartOptions;
1466 var
1467 param, i: Integer;
1468 value: String;
1469 begin
1470 param := 0;
1471 if (DeactivateIndexes in Options) then
1472 param := param or isc_spb_res_deactivate_idx;
1473 if (NoShadow in Options) then
1474 param := param or isc_spb_res_no_shadow;
1475 if (NoValidityCheck in Options) then
1476 param := param or isc_spb_res_no_validity;
1477 if (OneRelationAtATime in Options) then
1478 param := param or isc_spb_res_one_at_a_time;
1479 if (Replace in Options) then
1480 param := param or isc_spb_res_replace;
1481 if (CreateNewDB in Options) then
1482 param := param or isc_spb_res_create;
1483 if (UseAllSpace in Options) then
1484 param := param or isc_spb_res_use_all_space;
1485 Action := isc_action_svc_restore;
1486 ServiceStartParams := Char(isc_action_svc_restore);
1487 ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
1488 if Verbose then ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
1489 if FPageSize > 0 then
1490 ServiceStartAddParam(FPageSize, isc_spb_res_page_size);
1491 if FPageBuffers > 0 then
1492 ServiceStartAddParam(FPageBuffers, isc_spb_res_buffers);
1493 for i := 0 to FBackupFile.Count - 1 do
1494 begin
1495 if (Trim(FBackupFile[i]) = '') then continue;
1496 if (Pos('=', FBackupFile[i]) <> 0) then {mbcs ok}
1497 begin
1498 ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1499 value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1500 param := StrToInt(value);
1501 ServiceStartAddParam(param, isc_spb_bkp_length);
1502 end
1503 else
1504 ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
1505 end;
1506 for i := 0 to FDatabaseName.Count - 1 do
1507 begin
1508 if (Trim(FDatabaseName[i]) = '') then continue;
1509 if (Pos('=', FDatabaseName[i]) <> 0) then {mbcs ok}
1510 begin
1511 ServiceStartAddParam(FDatabaseName.Names[i], SPBConstantValues[isc_spb_dbname]);
1512 value := Copy(FDatabaseName[i], Pos('=', FDatabaseName[i]) + 1, Length(FDatabaseName[i])); {mbcs ok}
1513 param := StrToInt(value);
1514 ServiceStartAddParam(param, isc_spb_res_length);
1515 end
1516 else
1517 ServiceStartAddParam(FDatabaseName[i], SPBConstantValues[isc_spb_dbname]);
1518 end;
1519 end;
1520
1521 constructor TIBRestoreService.Create(AOwner: TComponent);
1522 begin
1523 inherited Create(AOwner);
1524 FDatabaseName := TStringList.Create;
1525 FBackupFile := TStringList.Create;
1526 Include (FOptions, CreateNewDB);
1527 end;
1528
1529 destructor TIBRestoreService.Destroy;
1530 begin
1531 FDatabaseName.Free;
1532 FBackupFile.Free;
1533 inherited Destroy;
1534 end;
1535
1536 procedure TIBRestoreService.SetBackupFile(const Value: TStrings);
1537 begin
1538 FBackupFile.Assign(Value);
1539 end;
1540
1541 procedure TIBRestoreService.SetDatabaseName(const Value: TStrings);
1542 begin
1543 FDatabaseName.Assign(Value);
1544 end;
1545
1546 { TIBValidationService }
1547 constructor TIBValidationService.Create(AOwner: TComponent);
1548 begin
1549 inherited Create(AOwner);
1550 end;
1551
1552 destructor TIBValidationService.Destroy;
1553 var
1554 i : Integer;
1555 begin
1556 for i := 0 to High(FLimboTransactionInfo) do
1557 FLimboTransactionInfo[i].Free;
1558 FLimboTransactionInfo := nil;
1559 inherited Destroy;
1560 end;
1561
1562 procedure TIBValidationService.FetchLimboTransactionInfo;
1563 var
1564 i, RunLen: Integer;
1565 Value: Char;
1566 begin
1567 ServiceQueryParams := Char(isc_info_svc_limbo_trans);
1568 InternalServiceQuery;
1569 RunLen := 0;
1570 if (OutputBuffer[RunLen] <> Char(isc_info_svc_limbo_trans)) then
1571 IBError(ibxeOutputParsingError, [nil]);
1572 Inc(RunLen, 3);
1573 for i := 0 to High(FLimboTransactionInfo) do
1574 FLimboTransactionInfo[i].Free;
1575 FLimboTransactionInfo := nil;
1576 i := 0;
1577 while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
1578 begin
1579 if (i >= Length(FLimboTransactionInfo)) then
1580 SetLength(FLimboTransactionInfo, i + 10);
1581 if FLimboTransactionInfo[i] = nil then
1582 FLimboTransactionInfo[i] := TLimboTransactionInfo.Create;
1583 with FLimboTransactionInfo[i] do
1584 begin
1585 if (OutputBuffer[RunLen] = Char(isc_spb_single_tra_id)) then
1586 begin
1587 Inc(RunLen);
1588 MultiDatabase := False;
1589 ID := ParseInteger(RunLen);
1590 end
1591 else
1592 begin
1593 Inc(RunLen);
1594 MultiDatabase := True;
1595 ID := ParseInteger(RunLen);
1596 HostSite := ParseString(RunLen);
1597 if (OutputBuffer[RunLen] <> Char(isc_spb_tra_state)) then
1598 IBError(ibxeOutputParsingError, [nil]);
1599 Inc(RunLen);
1600 Value := OutputBuffer[RunLen];
1601 Inc(RunLen);
1602 if (Value = Char(isc_spb_tra_state_limbo)) then
1603 State := LimboState
1604 else
1605 if (Value = Char(isc_spb_tra_state_commit)) then
1606 State := CommitState
1607 else
1608 if (Value = Char(isc_spb_tra_state_rollback)) then
1609 State := RollbackState
1610 else
1611 State := UnknownState;
1612 RemoteSite := ParseString(RunLen);
1613 RemoteDatabasePath := ParseString(RunLen);
1614 Value := OutputBuffer[RunLen];
1615 Inc(RunLen);
1616 if (Value = Char(isc_spb_tra_advise_commit)) then
1617 begin
1618 Advise := CommitAdvise;
1619 Action:= CommitAction;
1620 end
1621 else
1622 if (Value = Char(isc_spb_tra_advise_rollback)) then
1623 begin
1624 Advise := RollbackAdvise;
1625 Action := RollbackAction;
1626 end
1627 else
1628 begin
1629 { if no advice commit as default }
1630 Advise := UnknownAdvise;
1631 Action:= CommitAction;
1632 end;
1633 end;
1634 Inc (i);
1635 end;
1636 end;
1637 if (i > 0) then
1638 SetLength(FLimboTransactionInfo, i+1);
1639 end;
1640
1641 procedure TIBValidationService.FixLimboTransactionErrors;
1642 var
1643 i: Integer;
1644 begin
1645 ServiceStartParams := Char(isc_action_svc_repair);
1646 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1647 if (FGlobalAction = NoGlobalAction) then
1648 begin
1649 i := 0;
1650 while (FLimboTransactionInfo[i].ID <> 0) do
1651 begin
1652 if (FLimboTransactionInfo[i].Action = CommitAction) then
1653 ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans)
1654 else
1655 ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
1656 Inc(i);
1657 end;
1658 end
1659 else
1660 begin
1661 i := 0;
1662 if (FGlobalAction = CommitGlobal) then
1663 while (FLimboTransactionInfo[i].ID <> 0) do
1664 begin
1665 ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans);
1666 Inc(i);
1667 end
1668 else
1669 while (FLimboTransactionInfo[i].ID <> 0) do
1670 begin
1671 ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
1672 Inc(i);
1673 end;
1674 end;
1675 InternalServiceStart;
1676 end;
1677
1678 function TIBValidationService.GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
1679 begin
1680 if index <= High(FLimboTransactionInfo) then
1681 result := FLimboTransactionInfo[index]
1682 else
1683 result := nil;
1684 end;
1685
1686 function TIBValidationService.GetLimboTransactionInfoCount: integer;
1687 begin
1688 Result := High(FLimboTransactionInfo);
1689 end;
1690
1691 procedure TIBValidationService.SetDatabaseName(const Value: string);
1692 begin
1693 FDatabaseName := Value;
1694 end;
1695
1696 procedure TIBValidationService.SetServiceStartOptions;
1697 var
1698 param: Integer;
1699 begin
1700 Action := isc_action_svc_repair;
1701 if FDatabaseName = '' then
1702 IBError(ibxeStartParamsError, [nil]);
1703 param := 0;
1704 if (SweepDB in Options) then
1705 param := param or isc_spb_rpr_sweep_db;
1706 if (ValidateDB in Options) then
1707 param := param or isc_spb_rpr_validate_db;
1708 ServiceStartParams := Char(isc_action_svc_repair);
1709 ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1710 if param > 0 then
1711 ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1712 param := 0;
1713 if (LimboTransactions in Options) then
1714 param := param or isc_spb_rpr_list_limbo_trans;
1715 if (CheckDB in Options) then
1716 param := param or isc_spb_rpr_check_db;
1717 if (IgnoreChecksum in Options) then
1718 param := param or isc_spb_rpr_ignore_checksum;
1719 if (KillShadows in Options) then
1720 param := param or isc_spb_rpr_kill_shadows;
1721 if (MendDB in Options) then
1722 param := param or isc_spb_rpr_mend_db;
1723 if (ValidateFull in Options) then
1724 begin
1725 param := param or isc_spb_rpr_full;
1726 if not (MendDB in Options) then
1727 param := param or isc_spb_rpr_validate_db;
1728 end;
1729 if param > 0 then
1730 ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1731 end;
1732
1733 { TIBSecurityService }
1734 constructor TIBSecurityService.Create(AOwner: TComponent);
1735 begin
1736 inherited Create(AOwner);
1737 FModifyParams := [];
1738 end;
1739
1740 destructor TIBSecurityService.Destroy;
1741 var
1742 i : Integer;
1743 begin
1744 for i := 0 to High(FUserInfo) do
1745 FUserInfo[i].Free;
1746 FUserInfo := nil;
1747 inherited Destroy;
1748 end;
1749
1750 procedure TIBSecurityService.FetchUserInfo;
1751 var
1752 i, RunLen: Integer;
1753 begin
1754 ServiceQueryParams := Char(isc_info_svc_get_users);
1755 InternalServiceQuery;
1756 RunLen := 0;
1757 if (OutputBuffer[RunLen] <> Char(isc_info_svc_get_users)) then
1758 IBError(ibxeOutputParsingError, [nil]);
1759 Inc(RunLen);
1760 for i := 0 to High(FUserInfo) do
1761 FUserInfo[i].Free;
1762 FUserInfo := nil;
1763 i := 0;
1764 { Don't have any use for the combined length
1765 so increment past by 2 }
1766 Inc(RunLen, 2);
1767 while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
1768 begin
1769 if (i >= Length(FUSerInfo)) then
1770 SetLength(FUserInfo, i + 10);
1771 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_username)) then
1772 IBError(ibxeOutputParsingError, [nil]);
1773 Inc(RunLen);
1774 if FUserInfo[i] = nil then
1775 FUserInfo[i] := TUserInfo.Create;
1776 FUserInfo[i].UserName := ParseString(RunLen);
1777 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_firstname)) then
1778 IBError(ibxeOutputParsingError, [nil]);
1779 Inc(RunLen);
1780 FUserInfo[i].FirstName := ParseString(RunLen);
1781 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_middlename)) then
1782 IBError(ibxeOutputParsingError, [nil]);
1783 Inc(RunLen);
1784 FUserInfo[i].MiddleName := ParseString(RunLen);
1785 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_lastname)) then
1786 IBError(ibxeOutputParsingError, [nil]);
1787 Inc(RunLen);
1788 FUserInfo[i].LastName := ParseString(RunLen);
1789 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_userId)) then
1790 IBError(ibxeOutputParsingError, [nil]);
1791 Inc(RunLen);
1792 FUserInfo[i].UserId := ParseInteger(RunLen);
1793 if (OutputBuffer[RunLen] <> Char(isc_spb_sec_groupid)) then
1794 IBError(ibxeOutputParsingError, [nil]);
1795 Inc(RunLen);
1796 FUserInfo[i].GroupID := ParseInteger(RunLen);
1797 Inc (i);
1798 end;
1799 if (i > 0) then
1800 SetLength(FUserInfo, i+1);
1801 end;
1802
1803 function TIBSecurityService.GetUserInfo(Index: Integer): TUserInfo;
1804 begin
1805 if Index <= High(FUSerInfo) then
1806 result := FUserInfo[Index]
1807 else
1808 result := nil;
1809 end;
1810
1811 function TIBSecurityService.GetUserInfoCount: Integer;
1812 begin
1813 Result := Max(High(FUSerInfo),0);
1814 end;
1815
1816 procedure TIBSecurityService.AddUser;
1817 begin
1818 SecurityAction := ActionAddUser;
1819 ServiceStart;
1820 end;
1821
1822 procedure TIBSecurityService.DeleteUser;
1823 begin
1824 SecurityAction := ActionDeleteUser;
1825 ServiceStart;
1826 end;
1827
1828 procedure TIBSecurityService.DisplayUsers;
1829 begin
1830 SecurityAction := ActionDisplayUser;
1831 ServiceStartParams := Char(isc_action_svc_display_user);
1832 InternalServiceStart;
1833 FetchUserInfo;
1834 end;
1835
1836 procedure TIBSecurityService.DisplayUser(UserName: String);
1837 begin
1838 SecurityAction := ActionDisplayUser;
1839 ServiceStartParams := Char(isc_action_svc_display_user);
1840 ServiceStartAddParam (UserName, isc_spb_sec_username);
1841 InternalServiceStart;
1842 FetchUserInfo;
1843 end;
1844
1845 procedure TIBSecurityService.ModifyUser;
1846 begin
1847 SecurityAction := ActionModifyUser;
1848 ServiceStart;
1849 end;
1850
1851 procedure TIBSecurityService.SetSecurityAction (Value: TSecurityAction);
1852 begin
1853 FSecurityAction := Value;
1854 if Value = ActionDeleteUser then
1855 ClearParams;
1856 end;
1857
1858 procedure TIBSecurityService.ClearParams;
1859 begin
1860 FModifyParams := [];
1861 FFirstName := '';
1862 FMiddleName := '';
1863 FLastName := '';
1864 FGroupID := 0;
1865 FUserID := 0;
1866 FPassword := '';
1867 end;
1868
1869 procedure TIBSecurityService.SetFirstName (Value: String);
1870 begin
1871 FFirstName := Value;
1872 Include (FModifyParams, ModifyFirstName);
1873 end;
1874
1875 procedure TIBSecurityService.SetMiddleName (Value: String);
1876 begin
1877 FMiddleName := Value;
1878 Include (FModifyParams, ModifyMiddleName);
1879 end;
1880
1881 procedure TIBSecurityService.SetLastName (Value: String);
1882 begin
1883 FLastName := Value;
1884 Include (FModifyParams, ModifyLastName);
1885 end;
1886
1887 procedure TIBSecurityService.SetPassword (Value: String);
1888 begin
1889 FPassword := Value;
1890 Include (FModifyParams, ModifyPassword);
1891 end;
1892
1893 procedure TIBSecurityService.SetUserId (Value: Integer);
1894 begin
1895 FUserId := Value;
1896 Include (FModifyParams, ModifyUserId);
1897 end;
1898
1899 procedure TIBSecurityService.SetGroupId (Value: Integer);
1900 begin
1901 FGroupId := Value;
1902 Include (FModifyParams, ModifyGroupId);
1903 end;
1904
1905 procedure TIBSecurityService.Loaded;
1906 begin
1907 inherited Loaded;
1908 ClearParams;
1909 end;
1910
1911 procedure TIBSecurityService.SetServiceStartOptions;
1912 var
1913 Len: UShort;
1914
1915 begin
1916 case FSecurityAction of
1917 ActionAddUser:
1918 begin
1919 Action := isc_action_svc_add_user;
1920 if ( Pos(' ', FUserName) > 0 ) then
1921 IBError(ibxeStartParamsError, [nil]);
1922 Len := Length(FUserName);
1923 if (Len = 0) then
1924 IBError(ibxeStartParamsError, [nil]);
1925 ServiceStartParams := Char(isc_action_svc_add_user);
1926 ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
1927 ServiceStartAddParam (FUserName, isc_spb_sec_username);
1928 ServiceStartAddParam (FUserID, isc_spb_sec_userid);
1929 ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
1930 ServiceStartAddParam (FPassword, isc_spb_sec_password);
1931 ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
1932 ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
1933 ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
1934 end;
1935 ActionDeleteUser:
1936 begin
1937 Action := isc_action_svc_delete_user;
1938 Len := Length(FUserName);
1939 if (Len = 0) then
1940 IBError(ibxeStartParamsError, [nil]);
1941 ServiceStartParams := Char(isc_action_svc_delete_user);
1942 ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
1943 ServiceStartAddParam (FUserName, isc_spb_sec_username);
1944 end;
1945 ActionModifyUser:
1946 begin
1947 Action := isc_action_svc_modify_user;
1948 Len := Length(FUserName);
1949 if (Len = 0) then
1950 IBError(ibxeStartParamsError, [nil]);
1951 ServiceStartParams := Char(isc_action_svc_modify_user);
1952 ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
1953 ServiceStartAddParam (FUserName, isc_spb_sec_username);
1954 if (ModifyUserId in FModifyParams) then
1955 ServiceStartAddParam (FUserID, isc_spb_sec_userid);
1956 if (ModifyGroupId in FModifyParams) then
1957 ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
1958 if (ModifyPassword in FModifyParams) then
1959 ServiceStartAddParam (FPassword, isc_spb_sec_password);
1960 if (ModifyFirstName in FModifyParams) then
1961 ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
1962 if (ModifyMiddleName in FModifyParams) then
1963 ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
1964 if (ModifyLastName in FModifyParams) then
1965 ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
1966 end;
1967 end;
1968 ClearParams;
1969 end;
1970
1971 { TIBUnStructuredService }
1972 constructor TIBControlAndQueryService.Create(AOwner: TComponent);
1973 begin
1974 inherited Create(AOwner);
1975 FEof := False;
1976 FAction := 0;
1977 end;
1978
1979 procedure TIBControlAndQueryService.SetAction(Value: Integer);
1980 begin
1981 FEof := False;
1982 FAction := Value;
1983 end;
1984
1985
1986 function TIBControlAndQueryService.GetNextChunk: String;
1987 var
1988 Length: Integer;
1989 begin
1990 if (FEof = True) then
1991 begin
1992 result := '';
1993 exit;
1994 end;
1995 if (FAction = 0) then
1996 IBError(ibxeQueryParamsError, [nil]);
1997 ServiceQueryParams := Char(isc_info_svc_to_eof);
1998 InternalServiceQuery;
1999 if (OutputBuffer[0] <> Char(isc_info_svc_to_eof)) then
2000 IBError(ibxeOutputParsingError, [nil]);
2001 Length := isc_vax_integer(OutputBuffer + 1, 2);
2002 if (OutputBuffer[3 + Length] = Char(isc_info_truncated)) then
2003 FEof := False
2004 else
2005 if (OutputBuffer[3 + Length] = Char(isc_info_end)) then
2006 FEof := True
2007 else
2008 IBError(ibxeOutputParsingError, [nil]);
2009 OutputBuffer[3 + Length] := #0;
2010 result := String(PChar(@OutputBuffer[3]));
2011 end;
2012
2013 function TIBControlAndQueryService.GetNextLine: String;
2014 var
2015 Length: Integer;
2016 begin
2017 if (FEof = True) then
2018 begin
2019 result := '';
2020 exit;
2021 end;
2022 if (FAction = 0) then
2023 IBError(ibxeQueryParamsError, [nil]);
2024 ServiceQueryParams := Char(isc_info_svc_line);
2025 InternalServiceQuery;
2026 if (OutputBuffer[0] <> Char(isc_info_svc_line)) then
2027 IBError(ibxeOutputParsingError, [nil]);
2028 Length := isc_vax_integer(OutputBuffer + 1, 2);
2029 if (OutputBuffer[3 + Length] <> Char(isc_info_end)) then
2030 IBError(ibxeOutputParsingError, [nil]);
2031 if (length <> 0) then
2032 FEof := False
2033 else
2034 begin
2035 result := '';
2036 FEof := True;
2037 exit;
2038 end;
2039 OutputBuffer[3 + Length] := #0;
2040 result := String(PChar(@OutputBuffer[3]));
2041 end;
2042
2043 { TIBLogService }
2044
2045 procedure TIBLogService.SetServiceStartOptions;
2046 begin
2047 Action := isc_action_svc_get_ib_log;
2048 ServiceStartParams := Char(isc_action_svc_get_ib_log);
2049 end;
2050
2051 { TDatabaseInfo }
2052
2053 constructor TDatabaseInfo.Create;
2054 begin
2055 DbName := nil;
2056 end;
2057
2058 destructor TDatabaseInfo.Destroy;
2059 begin
2060 DbName := nil;
2061 inherited Destroy;
2062 end;
2063
2064 { TLicenseInfo }
2065
2066 constructor TLicenseInfo.Create;
2067 begin
2068 Key := nil;
2069 Id := nil;
2070 Desc := nil;
2071 end;
2072
2073 destructor TLicenseInfo.Destroy;
2074 begin
2075 Key := nil;
2076 Id := nil;
2077 Desc := nil;
2078 inherited Destroy;
2079 end;
2080
2081 { TConfigFileData }
2082
2083 constructor TConfigFileData.Create;
2084 begin
2085 ConfigFileValue := nil;
2086 ConfigFileKey := nil;
2087 end;
2088
2089 destructor TConfigFileData.Destroy;
2090 begin
2091 ConfigFileValue := nil;
2092 ConfigFileKey := nil;
2093 inherited Destroy;
2094 end;
2095
2096 { TConfigParams }
2097
2098 constructor TConfigParams.Create;
2099 begin
2100 ConfigFileData := TConfigFileData.Create;
2101 ConfigFileParams := nil;
2102 end;
2103
2104 destructor TConfigParams.Destroy;
2105 begin
2106 ConfigFileData.Free;
2107 ConfigFileParams := nil;
2108 inherited Destroy;
2109 end;
2110
2111 end.