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