ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBServices.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 62651 byte(s)
Log Message: 
Borland IBX Open Source Release

File Contents

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