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

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines