ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBServices.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (9 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 63854 byte(s)
Log Message: 
Committing updates for Release R1-3-1

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