ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBServices.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines