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