ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBServices.pas
Revision: 43
Committed: Thu Sep 22 17:10:15 2016 UTC (8 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 64108 byte(s)
Log Message: 
Committing updates for Release R1-4-3

File Contents

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