trunk/runtime/IBServices.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011                                                 }
{                                                                        }
{************************************************************************}

{
  InterBase Express provides component interfaces to
  functions introduced in InterBase 6.0.  The Services
  components (TIB*Service, TIBServerProperties)
  function only if you have installed InterBase 6.0 or
  later software, including Firebird
}

unit IBServices;

{$Mode Delphi}
{$codepage UTF8}

interface

uses
{$IFDEF WINDOWS }
  Windows,
{$ELSE}
  unix,
{$ENDIF}
  SysUtils, Classes, IBHeader, IB, IBExternals, CustApp, IBTypes, IBSQL;

const
  DefaultBufferSize = 32000;

  SPBPrefix = 'isc_spb_';
  isc_spb_last_spb_constant = 12;
  SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
    'user_name',
    'sys_user_name',
    'sys_user_name_enc',
    'password',
    'password_enc',
    'command_line',
    'db_name',
    'verbose',
    'options',
    'connect_timeout',
    'dummy_packet_interval',
    'sql_role_name'
  );

  SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
    isc_spb_user_name,
    isc_spb_sys_user_name,
    isc_spb_sys_user_name_enc,
    isc_spb_password,
    isc_spb_password_enc,
    isc_spb_command_line,
    isc_spb_dbname,
    isc_spb_verbose,
    isc_spb_options,
    isc_spb_connect_timeout,
    isc_spb_dummy_packet_interval,
    isc_spb_sql_role_name
  );

type
  TOutputBufferOption = (ByLine, ByChunk);

  TIBCustomService = class;

  TLoginEvent = procedure(Database: TIBCustomService;
    LoginParams: TStrings) of object;

  { TIBCustomService }

  TIBCustomService = class(TComponent)
  private
    FParamsChanged : Boolean;
    FSPB : ISPB;
    FSRB: ISRB;
    FSQPB: ISQPB;
    FTraceFlags: TTraceFlags;
    FOnLogin: TLoginEvent;
    FLoginPrompt: Boolean;
    FServerName: string;
    FService: IServiceManager;
    FStreamedActive  : Boolean;
    FOnAttach: TNotifyEvent;
    FProtocol: TProtocol;
    FParams: TStrings;
    FServiceQueryResults: IServiceQueryResults;
    function GetActive: Boolean;
    function GetServiceParamBySPB(const Idx: Integer): String;
    function GetSQPB: ISQPB;
    function GetSRB: ISRB;
    procedure SetActive(const Value: Boolean);
    procedure SetParams(const Value: TStrings);
    procedure SetServerName(const Value: string);
    procedure SetProtocol(const Value: TProtocol);
    procedure SetService(AValue: IServiceManager);
    procedure SetServiceParamBySPB(const Idx: Integer;
      const Value: String);
    function IndexOfSPBConst(action: byte): Integer;
    function GetSPBConstName(action: byte): string;
    procedure ParamsChange(Sender: TObject);
    procedure ParamsChanging(Sender: TObject);
    procedure CheckServerName;
    function GenerateSPB(sl: TStrings): ISPB;

  protected
    procedure Loaded; override;
    function Login(var aServerName: string): Boolean;
    procedure CheckActive;
    procedure CheckInactive;
    procedure HandleException(Sender: TObject);
    procedure InternalServiceQuery;
    property SRB: ISRB read GetSRB;
    property SQPB: ISQPB read GetSQPB;
    property ServiceQueryResults: IServiceQueryResults read FServiceQueryResults;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Attach;
    procedure Detach;

    {Copies database parameters as give in the DBParams to the Service
      omitting any parameters not appropriate for TIBService. Typically, the
      DBParams are TIBDatabase.Params}
    procedure SetDBParams(DBParams: TStrings);

    property ServiceIntf: IServiceManager read FService write SetService;
    property ServiceParamBySPB[const Idx: Integer]: String read GetServiceParamBySPB
                                                      write SetServiceParamBySPB;
  published
    property Active: Boolean read GetActive write SetActive default False;
    property ServerName: string read FServerName write SetServerName;
    property Protocol: TProtocol read FProtocol write SetProtocol default Local;
    property Params: TStrings read FParams write SetParams;
    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default True;
    property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
    property OnAttach: TNotifyEvent read FOnAttach write FOnAttach;
    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  end;

  TDatabaseInfo = class
  public
    NoOfAttachments: Integer;
    NoOfDatabases: Integer;
    DbName: array of string;
    constructor Create;
    destructor Destroy; override;
  end;

  TLicenseInfo = class
  public
    Key: array of string;
    Id: array of string;
    Desc: array of string;
    LicensedUsers: Integer;
    constructor Create;
    destructor Destroy; override;
  end;

  TLicenseMaskInfo = class
  public
    LicenseMask: Integer;
    CapabilityMask: Integer;
  end;

  TConfigFileData = class
  public
    ConfigFileValue: array of integer;
    ConfigFileKey: array of integer;
    constructor Create;
    destructor Destroy; override;
  end;

  TConfigParams = class
  public
    ConfigFileData: TConfigFileData;
    ConfigFileParams: array of string;
    BaseLocation: string;
    LockFileLocation: string;
    MessageFileLocation: string;
    SecurityDatabaseLocation: string;
    constructor Create;
    destructor Destroy; override;
  end;

  TVersionInfo = class
    ServerVersion: String;
    ServerImplementation: string;
    ServiceVersion: Integer;
  end;

  TPropertyOption = (Database, License, LicenseMask, ConfigParameters, Version);
  TPropertyOptions = set of TPropertyOption;

  TIBServerProperties = class(TIBCustomService)
  private
    FOptions: TPropertyOptions;
    FDatabaseInfo: TDatabaseInfo;
    FLicenseInfo: TLicenseInfo;
    FLicenseMaskInfo: TLicenseMaskInfo;
    FVersionInfo: TVersionInfo;
    FConfigParams: TConfigParams;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Fetch;
    procedure FetchDatabaseInfo;
    procedure FetchLicenseInfo;
    procedure FetchLicenseMaskInfo;
    procedure FetchConfigParams;
    procedure FetchVersionInfo;
    property DatabaseInfo: TDatabaseInfo read FDatabaseInfo;
    property LicenseInfo: TLicenseInfo read FLicenseInfo;
    property LicenseMaskInfo: TLicenseMaskInfo read FLicenseMaskInfo;
    property VersionInfo: TVersionInfo read FVersionInfo;
    property ConfigParams: TConfigParams read FConfigParams;
  published
    property Options : TPropertyOptions read FOptions write FOptions;
  end;

  { TIBControlService }

  TIBControlService = class (TIBCustomService)
  private
    function GetIsServiceRunning: Boolean;
  protected
    procedure CheckServiceNotRunning;
    procedure InternalServiceStart;
    procedure SetServiceStartOptions; virtual;

  public
    constructor Create(AOwner: TComponent); override;
    procedure ServiceStart; virtual;
    property IsServiceRunning : Boolean read GetIsServiceRunning;
  end;

  { TIBControlAndQueryService }

  TIBControlAndQueryService = class (TIBControlService)
  private
    FEof: Boolean;
    FAction: Integer;
    procedure SetAction(Value: Integer);
  protected
    property Action: Integer read FAction write SetAction;
  public
    constructor create (AOwner: TComponent); override;
    function GetNextLine : String;
    function GetNextChunk : String;
    function WriteNextChunk(stream: TStream): integer;
    property Eof: boolean read FEof;
  end;

  TShutdownMode = (Forced, DenyTransaction, DenyAttachment);

  TIBConfigService = class(TIBControlService)
  private
    FDatabaseName: string;
    procedure SetDatabaseName(const Value: string);
  protected

  public
    procedure ServiceStart; override;
    procedure ShutdownDatabase (Options: TShutdownMode; Wait: Integer);
    procedure SetSweepInterval (Value: Integer);
    procedure SetDBSqlDialect (Value: Integer);
    procedure SetPageBuffers (Value: Integer);
    procedure ActivateShadow;
    procedure BringDatabaseOnline;
    procedure SetReserveSpace (Value: Boolean);
    procedure SetAsyncMode (Value: Boolean);
    procedure SetReadOnly (Value: Boolean);
  published
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
  end;

  TIBLogService = class(TIBControlAndQueryService)
  private

  protected
    procedure SetServiceStartOptions; override;
  public
  published
  end;

  TStatOption = (DataPages, {DbLog,} HeaderPages, IndexPages, SystemRelations);
  TStatOptions = set of TStatOption;

  TIBStatisticalService = class(TIBControlAndQueryService)
  private
    FDatabaseName: string;
    FOptions: TStatOptions;
    procedure SetDatabaseName(const Value: string);
  protected
    procedure SetServiceStartOptions; override;
  public
  published
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property Options :  TStatOptions read FOptions write FOptions;
  end;

  TBackupLocation = (flServerSide,flClientSide);

  { TIBBackupRestoreService }

  TIBBackupRestoreService = class(TIBControlAndQueryService)
  private
    FBackupFileLocation: TBackupLocation;
    FVerbose: Boolean;
  protected
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Verbose : Boolean read FVerbose write FVerbose default False;
    property BackupFileLocation: TBackupLocation read FBackupFileLocation
                                                      write FBackupFileLocation default flServerSide;
  end;

  TBackupOption = (IgnoreChecksums, IgnoreLimbo, MetadataOnly, NoGarbageCollection,
    OldMetadataDesc, NonTransportable, ConvertExtTables);
  TBackupOptions = set of TBackupOption;

  TIBBackupService = class (TIBBackupRestoreService)
  private
    FDatabaseName: string;
    FOptions: TBackupOptions;
    FBackupFile: TStrings;
    FBlockingFactor: Integer;
    procedure SetBackupFile(const Value: TStrings);
  protected
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { a name=value pair of filename and length }
    property BackupFile: TStrings read FBackupFile write SetBackupFile;
    property BlockingFactor: Integer read FBlockingFactor write FBlockingFactor;
    property DatabaseName: string read FDatabaseName write FDatabaseName;
    property Options : TBackupOptions read FOptions write FOptions;
  end;

  TRestoreOption = (DeactivateIndexes, NoShadow, NoValidityCheck, OneRelationAtATime,
    Replace, CreateNewDB, UseAllSpace);

  TRestoreOptions = set of TRestoreOption;

  { TIBRestoreService }

  TIBRestoreService = class (TIBBackupRestoreService)
  private
    FDatabaseName: TStrings;
    FBackupFile: TStrings;
    FOptions: TRestoreOptions;
    FPageSize: Integer;
    FPageBuffers: Integer;
    FSendBytes: integer;
    procedure SetBackupFile(const Value: TStrings);
    procedure SetDatabaseName(const Value: TStrings);
  protected
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function SendNextChunk(stream: TStream; var line: String): integer;
  published
    { a name=value pair of filename and length }
    property DatabaseName: TStrings read FDatabaseName write SetDatabaseName;
    property BackupFile: TStrings read FBackupFile write SetBackupFile;
    property PageSize: Integer read FPageSize write FPageSize;
    property PageBuffers: Integer read FPageBuffers write FPageBuffers;
    property Options : TRestoreOptions read FOptions write FOptions default [CreateNewDB];
  end;

  TValidateOption = (LimboTransactions, CheckDB, IgnoreChecksum, KillShadows, MendDB,
    SweepDB, ValidateDB, ValidateFull);
  TValidateOptions = set of TValidateOption;

  TTransactionGlobalAction = (CommitGlobal, RollbackGlobal, RecoverTwoPhaseGlobal,
                             NoGlobalAction);
  TTransactionState = (LimboState, CommitState, RollbackState, UnknownState);
  TTransactionAdvise = (CommitAdvise, RollbackAdvise, UnknownAdvise);
  TTransactionAction = (CommitAction, RollbackAction);

  TLimboTransactionInfo = class
  public
    MultiDatabase: Boolean;
    ID: Integer;
    HostSite: String;
    RemoteSite: String;
    RemoteDatabasePath: String;
    State: TTransactionState;
    Advise: TTransactionAdvise;
    Action: TTransactionAction;
  end;

  TIBValidationService = class(TIBControlAndQueryService)
  private
    FDatabaseName: string;
    FOptions: TValidateOptions;
    FLimboTransactionInfo: array of TLimboTransactionInfo;
    FGlobalAction: TTransactionGlobalAction;
    procedure SetDatabaseName(const Value: string);
    function GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
    function GetLimboTransactionInfoCount: integer;

  protected
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure FetchLimboTransactionInfo;
    procedure FixLimboTransactionErrors;
    property LimboTransactionInfo[Index: integer]: TLimboTransactionInfo read GetLimboTransactionInfo;
    property LimboTransactionInfoCount: Integer read GetLimboTransactionInfoCount;

  published
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property Options: TValidateOptions read FOptions write FOptions;
    property GlobalAction: TTransactionGlobalAction read FGlobalAction
                                         write FGlobalAction;
  end;

  TUserInfo = class
  public
    UserName: string;
    FirstName: string;
    MiddleName: string;
    LastName: string;
    GroupID: Integer;
    UserID: Integer;
  end;

  TSecurityAction = (ActionAddUser, ActionDeleteUser, ActionModifyUser, ActionDisplayUser);
  TSecurityModifyParam = (ModifyFirstName, ModifyMiddleName, ModifyLastName, ModifyUserId,
                         ModifyGroupId, ModifyPassword);
  TSecurityModifyParams = set of TSecurityModifyParam;

  TIBSecurityService = class(TIBControlAndQueryService)
  private
    FUserID: Integer;
    FGroupID: Integer;
    FFirstName: string;
    FUserName: string;
    FPassword: string;
    FSQLRole: string;
    FLastName: string;
    FMiddleName: string;
    FUserInfo: array of TUserInfo;
    FSecurityAction: TSecurityAction;
    FModifyParams: TSecurityModifyParams;
    procedure ClearParams;
    procedure SetSecurityAction (Value: TSecurityAction);
    procedure SetFirstName (Value: String);
    procedure SetMiddleName (Value: String);
    procedure SetLastName (Value: String);
    procedure SetPassword (Value: String);
    procedure SetUserId (Value: Integer);
    procedure SetGroupId (Value: Integer);

    procedure FetchUserInfo;
    function GetUserInfo(Index: Integer): TUserInfo;
    function GetUserInfoCount: Integer;

  protected
    procedure Loaded; override;
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DisplayUsers;
    procedure DisplayUser(UserName: string);
    procedure AddUser;
    procedure DeleteUser;
    procedure ModifyUser;
    property  UserInfo[Index: Integer]: TUserInfo read GetUserInfo;
    property  UserInfoCount: Integer read GetUserInfoCount;

  published
    property SecurityAction: TSecurityAction read FSecurityAction
                                             write SetSecurityAction;
    property SQlRole : string read FSQLRole write FSQLrole;
    property UserName : string read FUserName write FUserName;
    property FirstName : string read FFirstName write SetFirstName;
    property MiddleName : string read FMiddleName write SetMiddleName;
    property LastName : string read FLastName write SetLastName;
    property UserID : Integer read FUserID write SetUserID;
    property GroupID : Integer read FGroupID write SetGroupID;
    property Password : string read FPassword write setPassword;
  end;


implementation

uses
  IBSQLMonitor, Math, FBMessages;

{ TIBBackupRestoreService }

constructor TIBBackupRestoreService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackupFileLocation := flServerSide;
end;

{ TIBCustomService }

procedure TIBCustomService.Attach;
var aServerName: string;
begin
  CheckInactive;
  CheckServerName;

  aServerName := FServerName;

  if FLoginPrompt and not Login(aServerName) then
    IBError(ibxeOperationCancelled, [nil]);

  { Generate a new SPB if necessary }
  if FParamsChanged then
  begin
    FParamsChanged := False;
    FSPB := GenerateSPB(FParams);
  end;

  FService := FirebirdAPI.GetServiceManager(aServerName,FProtocol,FSPB);

  if Assigned(FOnAttach) then
    FOnAttach(Self);

  MonitorHook.ServiceAttach(Self);
end;

procedure TIBCustomService.Loaded;
begin
  inherited Loaded;
  try
    if FStreamedActive and (not Active) then
      Attach;
  except
    if csDesigning in ComponentState then
       HandleException(self)
    else
      raise;
  end;
end;

function TIBCustomService.Login(var aServerName: string): Boolean;
var
  IndexOfUser, IndexOfPassword: Integer;
  Username, Password: String;
  LoginParams: TStrings;
begin
  if Assigned(FOnLogin) then begin
    result := True;
    LoginParams := TStringList.Create;
    try
      LoginParams.Assign(Params);
      FOnLogin(Self, LoginParams);
      Params.Assign (LoginParams);
      aServerName := ServerName;
    finally
      LoginParams.Free;
    end;
  end
  else
  if assigned(IBGUIInterface)  then
  begin
    IndexOfUser := IndexOfSPBConst(isc_spb_user_name);
    if IndexOfUser <> -1 then
      Username := Copy(Params[IndexOfUser],
                                         Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
                                         Length(Params[IndexOfUser]));
    IndexOfPassword := IndexOfSPBConst(isc_spb_password);
    if IndexOfPassword <> -1 then
      Password := Copy(Params[IndexOfPassword],
                                         Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
                                         Length(Params[IndexOfPassword]));
    result := IBGUIInterface.ServerLoginDialog(aServerName, Username, Password);
    if result then
    begin
      IndexOfPassword := IndexOfSPBConst(isc_spb_password);
      if IndexOfUser = -1 then
        Params.Add(GetSPBConstName(isc_spb_user_name) + '=' + Username)
      else
        Params[IndexOfUser] := GetSPBConstName(isc_spb_user_name) +
                                 '=' + Username;
      if IndexOfPassword = -1 then
        Params.Add(GetSPBConstName(isc_spb_password) + '=' + Password)
      else
        Params[IndexOfPassword] := GetSPBConstName(isc_spb_password) +
                                     '=' + Password;
    end
  end
  else
    IBError(ibxeNoLoginDialog,[]);
end;

procedure TIBCustomService.CheckActive;
begin
  if FStreamedActive and (not Active) then
    Loaded;
  if FService = nil then
    IBError(ibxeServiceActive, [nil]);
end;

procedure TIBCustomService.CheckInactive;
begin
  if FService <> nil then
    IBError(ibxeServiceInActive, [nil]);
end;

procedure TIBCustomService.HandleException(Sender: TObject);
var aParent: TComponent;
begin
  aParent := Owner;
  while aParent <> nil do
  begin
    if aParent is TCustomApplication then
    begin
      TCustomApplication(aParent).HandleException(Sender);
      Exit;
    end;
    aParent := aParent.Owner;
  end;
  SysUtils.ShowException(ExceptObject,ExceptAddr);
end;

constructor TIBCustomService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FserverName := '';
  FParams := TStringList.Create;
  FParamsChanged := True;
  TStringList(FParams).OnChange := ParamsChange;
  TStringList(FParams).OnChanging := ParamsChanging;
  FLoginPrompt := True;
  FTraceFlags := [];
  FService := nil;
  FSRB := nil;
  FSPB := nil;
  FServiceQueryResults := nil;
  FProtocol := Local;
  if (AOwner <> nil) and
     (AOwner is TCustomApplication) and
     TCustomApplication(AOwner).ConsoleApplication then
    LoginPrompt := false;
end;

destructor TIBCustomService.Destroy;
begin
  if FService <> nil then
      Detach;
  FSRB := nil;
  FSPB := nil;
  FParams.Free;
  FServiceQueryResults := nil;
  inherited Destroy;
end;

procedure TIBCustomService.Detach;
begin
  CheckActive;
  FService.Detach;
  FService := nil;
  MonitorHook.ServiceDetach(Self);
end;

procedure TIBCustomService.SetDBParams(DBParams: TStrings);
var i: integer;
    j: integer;
    k: integer;
    ParamName: string;
begin
  Params.Clear;
  for i := 0 to DBParams.Count - 1 do
  begin
    ParamName := DBParams[i];
    k := Pos('=',ParamName);
    if k > 0 then system.Delete(ParamName,k,Length(ParamName)-k+1);
    for j := 1 to isc_spb_last_spb_constant do
      if ParamName = SPBConstantNames[j] then
      begin
        Params.Add(DBParams[i]);
        break;
      end;
  end;
end;

function TIBCustomService.GetActive: Boolean;
begin
  result := FService <> nil;
end;

function TIBCustomService.GetServiceParamBySPB(const Idx: Integer): String;
var
  ConstIdx, EqualsIdx: Integer;
begin
  if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
  begin
    ConstIdx := IndexOfSPBConst(Idx);
    if ConstIdx = -1 then
      result := ''
    else
    begin
      result := Params[ConstIdx];
      EqualsIdx := Pos('=', result); {mbcs ok}
      if EqualsIdx = 0 then
        result := ''
      else
        result := Copy(result, EqualsIdx + 1, Length(result));
    end;
  end
  else
    result := '';
end;

function TIBCustomService.GetSQPB: ISQPB;
begin
  CheckActive;
  if FSQPB = nil then
    FSQPB := FService.AllocateSQPB;
  Result := FSQPB;
end;

function TIBCustomService.GetSRB: ISRB;
begin
  CheckActive;
  if FSRB = nil then
    FSRB := FService.AllocateSRB;
  Result := FSRB;
end;

procedure TIBCustomService.InternalServiceQuery;
begin
  CheckActive;
  FServiceQueryResults := FService.Query(FSQPB,FSRB);
  FSQPB := nil;
  FSRB := nil;
  MonitorHook.ServiceQuery(Self);
end;

procedure TIBCustomService.SetActive(const Value: Boolean);
begin
  if csReading in ComponentState then
    FStreamedActive := Value
  else
    if Value <> Active then
    begin
      if Value then
        Attach
      else
        Detach;
    end
   else if Value then
   begin
     FService.Detach;
     FService.Attach;
   end;
end;

procedure TIBCustomService.SetParams(const Value: TStrings);
begin
  FParams.Assign(Value);
end;

procedure TIBCustomService.SetServerName(const Value: string);
begin
  if FServerName <> Value then
  begin
    CheckInactive;
    FServerName := Value;
  end;
end;

procedure TIBCustomService.SetProtocol(const Value: TProtocol);
begin
  if FProtocol <> Value then
  begin
    CheckInactive;
    FProtocol := Value;
    if (Value = Local) then
      FServerName := '';
  end;
end;

procedure TIBCustomService.SetService(AValue: IServiceManager);
begin
  if FService = AValue then Exit;
  FService := AValue;
  if AValue <> nil then
    FServerName := FService.getServerName;
end;

procedure TIBCustomService.SetServiceParamBySPB(const Idx: Integer;
  const Value: String);
var
  ConstIdx: Integer;
begin
  ConstIdx := IndexOfSPBConst(Idx);
  if (Value = '') then
  begin
    if ConstIdx <> -1 then
      Params.Delete(ConstIdx);
  end
  else
  begin
    if (ConstIdx = -1) then
      Params.Add(GetSPBConstName(Idx) + '=' + Value)
    else
      Params[ConstIdx] := GetSPBConstName(Idx) + '=' + Value;
  end;
end;

function TIBCustomService.IndexOfSPBConst(action: byte): Integer;
var
  i,  pos_of_str: Integer;
  st: string;
begin
  result := -1;
  st := GetSPBConstName(action);
  if st <> '' then
  for i := 0 to Params.Count - 1 do
  begin
    pos_of_str := Pos(st, Params[i]); {mbcs ok}
    if (pos_of_str = 1) or (pos_of_str = Length(SPBPrefix) + 1) then
    begin
      result := i;
      break;
    end;
  end;
end;

function TIBCustomService.GetSPBConstName(action: byte): string;
var i: integer;
begin
  Result := '';
  for i := Low(SPBConstantValues) to High(SPBConstantValues) do
    if SPBConstantValues[i] = action then
    begin
      Result := SPBConstantNames[i];
      break;
    end;
end;

procedure TIBCustomService.ParamsChange(Sender: TObject);
begin
  FParamsChanged := True;
end;

procedure TIBCustomService.ParamsChanging(Sender: TObject);
begin
  CheckInactive;
end;

procedure TIBCustomService.CheckServerName;
begin
  if (FServerName = '') and (FProtocol <> Local) then
    IBError(ibxeServerNameMissing, [nil]);
end;

{
 * GenerateSPB -
 *  Given a string containing a textual representation
 *  of the Service parameters, generate a service
 *  parameter buffer, and return it .
}
function TIBCustomService.GenerateSPB(sl: TStrings): ISPB;
var
  i, j, SPBVal, SPBServerVal: UShort;
  param_name, param_value: String;
begin
  { The SPB is initially empty, with the exception that
   the SPB version must be the first byte of the string.
  }
  Result := FirebirdAPI.AllocateSPB;

  { Iterate through the textual service parameters, constructing
   a SPB on-the-fly }
  if sl.Count > 0 then
  for i := 0 to sl.Count - 1 do
  begin
   { Get the parameter's name and value from the list,
     and make sure that the name is all lowercase with
     no leading 'isc_spb_' prefix }
    if (Trim(sl.Names[i]) = '') then continue;
    param_name := LowerCase(sl.Names[i]); {mbcs ok}
    param_value := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
    if (Pos(SPBPrefix, param_name) = 1) then {mbcs ok}
      Delete(param_name, 1, Length(SPBPrefix));
    { We want to translate the parameter name to some integer
      value. We do this by scanning through a list of known
      service parameter names (SPBConstantNames, defined above). }
    SPBVal := 0;
    SPBServerVal := 0;
    { Find the parameter }
    for j := 1 to isc_spb_last_spb_constant do
      if (param_name = SPBConstantNames[j]) then
      begin
        SPBVal := j;
        SPBServerVal := SPBConstantValues[j];
        break;
      end;
    case SPBServerVal of
      isc_spb_user_name, isc_spb_password:
        Result.Add(SPBServerVal).AsString := param_value;
      else
      begin
        if GetSPBConstName(SPBServerVal) <> '' then
          IBError(ibxeSPBConstantNotSupported,
                   [GetSPBConstName(SPBServerVal)])
        else
          IBError(ibxeSPBConstantUnknown, [SPBServerVal]);
      end;
    end;
  end;
end;

{ TIBServerProperties }
constructor TIBServerProperties.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDatabaseInfo := TDatabaseInfo.Create;
  FLicenseInfo := TLicenseInfo.Create;
  FLicenseMaskInfo := TLicenseMaskInfo.Create;
  FVersionInfo := TVersionInfo.Create;
  FConfigParams := TConfigParams.Create;
end;

destructor TIBServerProperties.Destroy;
begin
  FDatabaseInfo.Free;
  FLicenseInfo.Free;
  FLicenseMaskInfo.Free;
  FVersionInfo.Free;
  FConfigParams.Free;
  inherited Destroy;
end;

procedure TIBServerProperties.Fetch;
begin
  if (Database in Options) then
    FetchDatabaseInfo;
  if (License in Options) then
    FetchLicenseInfo;
  if (LicenseMask in Options) then
    FetchLicenseMaskInfo;
  if (ConfigParameters in Options) then
    FetchConfigParams;
  if (Version in Options) then
    FetchVersionInfo;
end;

procedure TIBServerProperties.FetchConfigParams;
var
  i, j: Integer;

begin
  SRB.Add(isc_info_svc_get_config);
  SRB.Add(isc_info_svc_get_env);
  SRB.Add(isc_info_svc_get_env_lock);
  SRB.Add(isc_info_svc_get_env_msg);
  SRB.Add(isc_info_svc_user_dbpath);

  InternalServiceQuery;

  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_get_config:
      begin
        SetLength (FConfigParams.ConfigFileData.ConfigFileValue, Count);
        SetLength (FConfigParams.ConfigFileData.ConfigFileKey, Count);

        for j := 0 to Count - 1 do
        begin
          FConfigParams.ConfigFileData.ConfigFileKey[j] := Items[j].getItemType;
          FConfigParams.ConfigFileData.ConfigFileValue[j] := Items[j].AsInteger;
        end;
      end;

      isc_info_svc_get_env:
        FConfigParams.BaseLocation := AsString;

      isc_info_svc_get_env_lock:
        FConfigParams.LockFileLocation := AsString;

      isc_info_svc_get_env_msg:
        FConfigParams.MessageFileLocation := AsString;

      isc_info_svc_user_dbpath:
        FConfigParams.SecurityDatabaseLocation := AsString;

      else
        IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

procedure TIBServerProperties.FetchDatabaseInfo;
var
  i,j: Integer;
begin
  SRB.Add(isc_info_svc_svr_db_info);
  InternalServiceQuery;

  SetLength(FDatabaseInfo.DbName,0);
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_svr_db_info:
        for j := 0 to FServiceQueryResults[i].Count - 1 do
        with FServiceQueryResults[i][j] do
        case getItemType of
        isc_spb_num_att:
          FDatabaseInfo.NoOfAttachments := AsInteger;

        isc_spb_num_db:
          FDatabaseInfo.NoOfDatabases := AsInteger;

        isc_spb_dbname:
          begin
            SetLength(FDatabaseInfo.DbName,length(FDatabaseInfo.DbName)+1);
            FDatabaseInfo.DbName[length(FDatabaseInfo.DbName)-1] := AsString;
          end;
        else
          IBError(ibxeOutputParsingError, [getItemType]);
        end;
      else
        IBError(ibxeOutputParsingError, [getItemType]);
    end;
 end;
end;

procedure TIBServerProperties.FetchLicenseInfo;
var
  i,j : Integer;
begin
  SRB.Add(isc_info_svc_get_license);
  SRB.Add(isc_info_svc_get_licensed_users);
  InternalServiceQuery;

  SetLength(FLicenseInfo.key, 0);
  SetLength(FLicenseInfo.id, 0);
  SetLength(FLicenseInfo.desc, 0);

  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_get_license:
        begin
          SetLength(FLicenseInfo.key, Count);
          SetLength(FLicenseInfo.id, Count);
          SetLength(FLicenseInfo.desc, Count);

          for j := 0 to Count -1 do
          with Items[j] do
          case getItemType of
             isc_spb_lic_id:
                FLicenseInfo.id[j] := AsString;

             isc_spb_lic_key:
                FLicenseInfo.key[j] := AsString;

             isc_spb_lic_desc:
               FLicenseInfo.desc[j] := AsString;
          else
            IBError(ibxeOutputParsingError, [getItemType]);
          end;
        end;
      else
        IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

procedure TIBServerProperties.FetchLicenseMaskInfo();
var
  i : Integer;
begin
  SRB.Add(isc_info_svc_get_license_mask);
  SRB.Add(isc_info_svc_capabilities);
  InternalServiceQuery;

  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_get_license_mask:
        FLicenseMaskInfo.LicenseMask := AsInteger;
      isc_info_svc_capabilities:
        FLicenseMaskInfo.CapabilityMask := AsInteger;
      else
        IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;


procedure TIBServerProperties.FetchVersionInfo;
var
  i : Integer;
begin
  SRB.Add(isc_info_svc_version);
  SRB.Add(isc_info_svc_server_version);
  SRB.Add(isc_info_svc_implementation);
  InternalServiceQuery;

  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_version:
        FVersionInfo.ServiceVersion := AsInteger;
      isc_info_svc_server_version:
        FVersionInfo.ServerVersion := AsString;
      isc_info_svc_implementation:
        FVersionInfo.ServerImplementation := AsString;
      else
        IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

{ TIBControlService }

procedure TIBControlService.SetServiceStartOptions;
begin

end;

function TIBControlService.GetIsServiceRunning: Boolean;
begin
  SRB.Add(isc_info_svc_running);
  InternalServiceQuery;

  Result := (FServiceQueryResults.Count > 0) and
             (FServiceQueryResults[0].getItemType = isc_info_svc_running) and
              (FServiceQueryResults[0].AsInteger = 1);
end;

procedure TIBControlService.CheckServiceNotRunning;
begin
  if IsServiceRunning then
    IBError(ibxeServiceRunning,[nil]);
end;

constructor TIBControlService.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FSRB := nil;
  FSPB := nil;
end;

procedure TIBControlService.InternalServiceStart;
begin
  if SRB = nil then
    IBError(ibxeStartParamsError, [nil]);

  try
    FService.Start(SRB);
  finally
    FSRB := nil;
  end;
  MonitorHook.ServiceStart(Self);
end;

procedure TIBControlService.ServiceStart;
begin
  CheckActive;
  CheckServiceNotRunning;
  SetServiceStartOptions;
  InternalServiceStart;
end;

{ TIBConfigService }

procedure TIBConfigService.ServiceStart;
begin
  IBError(ibxeUseSpecificProcedures, [nil]);
end;

procedure TIBConfigService.ActivateShadow;
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_activate;
  InternalServiceStart;
end;

procedure TIBConfigService.BringDatabaseOnline;
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_db_online;
  InternalServiceStart;
end;

procedure TIBConfigService.SetAsyncMode(Value: Boolean);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  with SRB.Add(isc_spb_prp_write_mode) do
  if Value then
    AsByte := isc_spb_prp_wm_async
  else
    AsByte := isc_spb_prp_wm_sync;
  InternalServiceStart;
end;

procedure TIBConfigService.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TIBConfigService.SetPageBuffers(Value: Integer);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  SRB.Add(isc_spb_prp_page_buffers).AsInteger := Value;
  InternalServiceStart;
end;

procedure TIBConfigService.SetReadOnly(Value: Boolean);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  with SRB.Add(isc_spb_prp_access_mode) do
  if Value then
    AsByte := isc_spb_prp_am_readonly
  else
    AsByte := isc_spb_prp_am_readwrite;
  InternalServiceStart;
end;

procedure TIBConfigService.SetReserveSpace(Value: Boolean);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  with SRB.Add(isc_spb_prp_reserve_space) do
  if Value then
    AsByte := isc_spb_prp_res
  else
    AsByte := isc_spb_prp_res_use_full;
  InternalServiceStart;
end;

procedure TIBConfigService.SetSweepInterval(Value: Integer);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  SRB.Add(isc_spb_prp_sweep_interval).AsInteger := Value;
  InternalServiceStart;
end;

procedure TIBConfigService.SetDBSqlDialect(Value: Integer);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  SRB.Add(isc_spb_prp_set_sql_dialect).AsInteger := Value;
  InternalServiceStart;
end;

procedure TIBConfigService.ShutdownDatabase(Options: TShutdownMode;
  Wait: Integer);
begin
  SRB.Add(isc_action_svc_properties);
  SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
  if (Options = Forced) then
  SRB.Add(isc_spb_prp_shutdown_db).AsInteger := Wait
  else if (Options = DenyTransaction) then
    SRB.Add(isc_spb_prp_deny_new_transactions).AsInteger := Wait
  else
    SRB.Add(isc_spb_prp_deny_new_attachments).AsInteger := Wait;
  InternalServiceStart;
end;


{ TIBStatisticalService }

procedure TIBStatisticalService.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TIBStatisticalService.SetServiceStartOptions;
var param: integer;
begin
  if FDatabaseName = '' then
    IBError(ibxeStartParamsError, [nil]);

  param := 0;
  if (DataPages in Options) then
    param := param or isc_spb_sts_data_pages;
{  if (DbLog in Options) then
    param := param or isc_spb_sts_db_log; -- removed from Firebird 2}
  if (HeaderPages in Options) then
    param := param or isc_spb_sts_hdr_pages;
  if (IndexPages in Options) then
    param := param or isc_spb_sts_idx_pages;
  if (SystemRelations in Options) then
    param := param or isc_spb_sts_sys_relations;
  Action := isc_action_svc_db_stats;
  SRB.Add(isc_action_svc_db_stats);
  SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
  SRB.Add(isc_spb_options).AsInteger := param;
end;

{ TIBBackupService }
procedure TIBBackupService.SetServiceStartOptions;
var
  param, i: Integer;
  value: String;
begin
  if FDatabaseName = '' then
    IBError(ibxeStartParamsError, [nil]);
  param := 0;
  if (IgnoreChecksums in Options) then
    param := param or isc_spb_bkp_ignore_checksums;
  if (IgnoreLimbo in Options) then
    param := param or isc_spb_bkp_ignore_limbo;
  if (MetadataOnly in Options) then
    param := param or isc_spb_bkp_metadata_only;
  if (NoGarbageCollection in Options) then
    param := param or isc_spb_bkp_no_garbage_collect;
  if (OldMetadataDesc in Options) then
    param := param or isc_spb_bkp_old_descriptions;
  if (NonTransportable in Options) then
    param := param or isc_spb_bkp_non_transportable;
  if (ConvertExtTables in Options) then
    param := param or isc_spb_bkp_convert;
  Action := isc_action_svc_backup;
  SRB.Add(isc_action_svc_backup);
  SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
  SRB.Add(isc_spb_options).AsInteger := param;
  if Verbose  and (BackupFileLocation = flServerSide) then
    SRB.Add(isc_spb_verbose);
  if FBlockingFactor > 0 then
    SRB.Add(isc_spb_bkp_factor).AsInteger := FBlockingFactor;
  if BackupFileLocation = flServerSide then
  for i := 0 to FBackupFile.Count - 1 do
  begin
    if (Trim(FBackupFile[i]) = '') then
      continue;
    if (Pos('=', FBackupFile[i]) <> 0) then
    begin {mbcs ok}
      SRB.Add(isc_spb_bkp_file).AsString := FBackupFile.Names[i];
      value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
      SRB.Add(isc_spb_bkp_length).AsInteger := StrToInt(value);;
    end
    else
      SRB.Add(isc_spb_bkp_file).AsString := FBackupFile[i];
  end
  else
  SRB.Add(isc_spb_bkp_file).AsString := 'stdout';
end;

constructor TIBBackupService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackupFile := TStringList.Create;
end;

destructor TIBBackupService.Destroy;
begin
  FBackupFile.Free;
  inherited Destroy;
end;

procedure TIBBackupService.SetBackupFile(const Value: TStrings);
begin
  FBackupFile.Assign(Value);
end;

{ TIBRestoreService }

procedure TIBRestoreService.SetServiceStartOptions;
var
  param, i: Integer;
  value: String;
begin
  param := 0;
  if (DeactivateIndexes in Options) then
    param := param or isc_spb_res_deactivate_idx;
  if (NoShadow in Options) then
    param := param or isc_spb_res_no_shadow;
  if (NoValidityCheck in Options) then
    param := param or isc_spb_res_no_validity;
  if (OneRelationAtATime in Options) then
    param := param or isc_spb_res_one_at_a_time;
  if (Replace in Options) then
    param := param or isc_spb_res_replace;
  if (CreateNewDB in Options) then
    param := param or isc_spb_res_create;
  if (UseAllSpace in Options) then
    param := param or isc_spb_res_use_all_space;
  Action := isc_action_svc_restore;
  SRB.Add(isc_action_svc_restore);
  SRB.Add(isc_spb_options).AsInteger := param;
  if Verbose then
    SRB.Add(isc_spb_verbose);
  if FPageSize > 0 then
    SRB.Add(isc_spb_res_page_size).AsInteger := FPageSize;
  if FPageBuffers > 0 then
    SRB.Add(isc_spb_res_buffers).AsInteger := FPageBuffers;
  if BackupFileLocation = flServerSide then
  for i := 0 to FBackupFile.Count - 1 do
  begin
    if (Trim(FBackupFile[i]) = '') then continue;
    if (Pos('=', FBackupFile[i]) <> 0) then  {mbcs ok}
    begin 
      SRB.Add(isc_spb_bkp_file).AsString := FBackupFile.Names[i];
      value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
      SRB.Add(isc_spb_bkp_length).AsInteger := StrToInt(value);;
    end
    else
      SRB.Add(isc_spb_bkp_file).AsString := FBackupFile[i];
  end
  else
    SRB.Add(isc_spb_bkp_file).AsString := 'stdin';

  for i := 0 to FDatabaseName.Count - 1 do
  begin
    if (Trim(FDatabaseName[i]) = '') then continue;
    if (Pos('=', FDatabaseName[i]) <> 0) then {mbcs ok}
    begin
      SRB.Add(isc_spb_dbname).AsString := FDatabaseName.Names[i];
      value := Copy(FDatabaseName[i], Pos('=', FDatabaseName[i]) + 1, Length(FDatabaseName[i])); {mbcs ok}
      SRB.Add(isc_spb_res_length).AsInteger :=  StrToInt(value);
    end
    else
      SRB.Add(isc_spb_dbname).AsString := FDatabaseName[i];
  end;
end;

constructor TIBRestoreService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDatabaseName := TStringList.Create;
  FBackupFile := TStringList.Create;
  Include (FOptions, CreateNewDB);
end;

destructor TIBRestoreService.Destroy;
begin
  FDatabaseName.Free;
  FBackupFile.Free;
  inherited Destroy;
end;

function TIBRestoreService.SendNextChunk(stream: TStream; var line: String
  ): integer;
var
  i: Integer;
begin
  Result := 0;
  line := '';
  if (FEof = True) then
    exit;

  if (FAction = 0) then
    IBError(ibxeQueryParamsError, [nil]);

  SRB.Add(isc_info_svc_line);
  SRB.Add(isc_info_svc_stdin);

  SQPB.Add(isc_info_svc_timeout).AsInteger := 1;
  if FSendBytes > 0 then
    Result := SQPB.Add(isc_info_svc_line).CopyFrom(stream,FSendBytes);
  InternalServiceQuery;

  FSendBytes := 0;
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_line:
         line := AsString;

      isc_info_svc_stdin:
        FSendBytes := AsInteger;

      isc_info_svc_timeout,
      isc_info_data_not_ready:
        {ignore};
    else
      IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
  FEOF := (FSendBytes = 0) and (line = '');
end;

procedure TIBRestoreService.SetBackupFile(const Value: TStrings);
begin
  FBackupFile.Assign(Value);
end;

procedure TIBRestoreService.SetDatabaseName(const Value: TStrings);
begin
  FDatabaseName.Assign(Value);
end;

{ TIBValidationService }
constructor TIBValidationService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TIBValidationService.Destroy;
var
  i : Integer;
begin
  for i := 0 to High(FLimboTransactionInfo) do
    FLimboTransactionInfo[i].Free;
  FLimboTransactionInfo := nil;
  inherited Destroy;
end;

procedure TIBValidationService.FetchLimboTransactionInfo;

  procedure NextLimboTransaction(index: integer);
  begin
    SetLength(FLimboTransactionInfo, index+1);
    FLimboTransactionInfo[index] := TLimboTransactionInfo.Create;
    { if no advice commit as default }
    FLimboTransactionInfo[index].Advise := UnknownAdvise;
    FLimboTransactionInfo[index].Action:= CommitAction;
  end;

var
  i,j, k: Integer;
  Value: Char;
begin
  for i := 0 to High(FLimboTransactionInfo) do
    FLimboTransactionInfo[i].Free;
  SetLength(FLimboTransactionInfo,0);

  SRB.Add(isc_info_svc_limbo_trans);
  InternalServiceQuery;

  k := -1;
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  case getItemType of
  isc_info_svc_limbo_trans:
    begin
      if FServiceQueryResults[i].Count = 0 then continue;
      NextLimboTransaction(0);
      for j := 0 to FServiceQueryResults[i].Count - 1 do
      begin
        with FServiceQueryResults[i][j] do
        begin
          case getItemType of
            isc_spb_single_tra_id:
            begin
              Inc(k);
              if k > 0 then
                NextLimboTransaction(k);
              FLimboTransactionInfo[k].MultiDatabase := False;
              FLimboTransactionInfo[k].ID := AsInteger;
            end;

            isc_spb_multi_tra_id:
            begin
              Inc(k);
              if k > 0 then
                NextLimboTransaction(k);
              FLimboTransactionInfo[k].MultiDatabase := True;
              FLimboTransactionInfo[k].ID := AsInteger;
            end;

            isc_spb_tra_host_site:
              FLimboTransactionInfo[k].HostSite := AsString;

            isc_spb_tra_state:
              case AsByte of
                isc_spb_tra_state_limbo:
                  FLimboTransactionInfo[k].State := LimboState;

                isc_spb_tra_state_commit:
                  FLimboTransactionInfo[k].State := CommitState;

                isc_spb_tra_state_rollback:
                  FLimboTransactionInfo[k].State := RollbackState;

                else
                  FLimboTransactionInfo[k].State := UnknownState;
              end;

            isc_spb_tra_remote_site:
              FLimboTransactionInfo[k].RemoteSite := AsString;

            isc_spb_tra_db_path:
              FLimboTransactionInfo[k].RemoteDatabasePath := AsString;

            isc_spb_tra_advise:
            with FLimboTransactionInfo[k] do
            begin
              case (AsByte) of
              isc_spb_tra_advise_commit:
              begin
                Advise := CommitAdvise;
                Action:= CommitAction;
              end;

              isc_spb_tra_advise_rollback:
              begin
                Advise := RollbackAdvise;
                Action := RollbackAction;
              end;

              else
                Advise := UnknownAdvise;
              end;
            end;

            else
              IBError(ibxeOutputParsingError, [getItemType]);
          end;
        end;
      end;
    end;
  else
    IBError(ibxeOutputParsingError, [getItemType]);
  end;
end;

procedure TIBValidationService.FixLimboTransactionErrors;
var
  i: Integer;
begin
  SRB.Add(isc_action_svc_repair);
  SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
  case FGlobalAction of
  NoGlobalAction:
    begin
      for i := 0 to LimboTransactionInfoCount - 1 do
      begin
        if (FLimboTransactionInfo[i].Action = CommitAction) then
          SRB.Add(isc_spb_rpr_commit_trans).AsInteger :=  FLimboTransactionInfo[i].ID
        else
          SRB.Add(isc_spb_rpr_rollback_trans).AsInteger :=  FLimboTransactionInfo[i].ID;
      end;
    end;

  CommitGlobal:
    begin
      for i := 0 to LimboTransactionInfoCount - 1 do
        SRB.Add(isc_spb_rpr_commit_trans).AsInteger :=  FLimboTransactionInfo[i].ID;
    end;

    RollbackGlobal:
      begin
        for i := 0 to LimboTransactionInfoCount - 1 do
          SRB.Add(isc_spb_rpr_rollback_trans).AsInteger :=  FLimboTransactionInfo[i].ID;
      end;

    RecoverTwoPhaseGlobal:
    begin
      for i := 0 to LimboTransactionInfoCount - 1 do
        SRB.Add(isc_spb_rpr_recover_two_phase).AsInteger :=  FLimboTransactionInfo[i].ID;
    end;
  end;
  InternalServiceStart;
end;

function TIBValidationService.GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
begin
  if index <= High(FLimboTransactionInfo) then
    result := FLimboTransactionInfo[index]
  else
    result := nil;
end;

function TIBValidationService.GetLimboTransactionInfoCount: integer;
begin
  Result := Length(FLimboTransactionInfo);
end;

procedure TIBValidationService.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TIBValidationService.SetServiceStartOptions;
var
  param: Integer;
begin
  Action := isc_action_svc_repair;
  if FDatabaseName = '' then
    IBError(ibxeStartParamsError, [nil]);
  SRB.Add(isc_action_svc_repair);
  SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
  param := 0;
  if (SweepDB in Options) then
    param := param or isc_spb_rpr_sweep_db;
  if (ValidateDB in Options) then
    param := param or isc_spb_rpr_validate_db;

  if (LimboTransactions in Options) then
    param := param or isc_spb_rpr_list_limbo_trans;
  if (CheckDB in Options) then
    param := param or isc_spb_rpr_check_db;
  if (IgnoreChecksum in Options) then
    param := param or isc_spb_rpr_ignore_checksum;
  if (KillShadows in Options) then
    param := param or isc_spb_rpr_kill_shadows;
  if (MendDB in Options) then
    param := param or isc_spb_rpr_mend_db;
  if (ValidateFull in Options) then
  begin
     param := param or isc_spb_rpr_full;
     if not (MendDB in Options) then
       param := param or isc_spb_rpr_validate_db;
  end;
  if param > 0 then
   SRB.Add(isc_spb_options).AsInteger := param;
end;

{ TIBSecurityService }
constructor TIBSecurityService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModifyParams := [];
end;

destructor TIBSecurityService.Destroy;
var
  i : Integer;
begin
  for i := 0 to High(FUserInfo) do
    FUserInfo[i].Free;
  FUserInfo := nil;
  inherited Destroy;
end;

procedure TIBSecurityService.FetchUserInfo;
var
  i, j, k: Integer;
begin
  SRB.Add(isc_info_svc_get_users);
  InternalServiceQuery;

  for i := 0 to High(FUserInfo) do
    FUserInfo[i].Free;
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
    isc_info_svc_get_users:
      begin
        SetLength(FUserInfo,1);
        k := 0;
        FUserInfo[0] := TUserInfo.Create;
        FUserInfo[0].UserName := '';
        for j := 0 to FServiceQueryResults[i].Count - 1 do
        begin
          with FServiceQueryResults[i][j] do
          case getItemType of
          isc_spb_sec_username:
            begin
              if FUserInfo[k].UserName <> '' then
              begin
                Inc(k);
                SetLength(FUserInfo,k+1);
                if FUserInfo[k] = nil then
                  FUserInfo[k] := TUserInfo.Create;
              end;
              FUserInfo[k].UserName := AsString;
            end;

          isc_spb_sec_firstname:
            FUserInfo[k].FirstName := AsString;

          isc_spb_sec_middlename:
            FUserInfo[k].MiddleName := AsString;

          isc_spb_sec_lastname:
            FUserInfo[k].LastName := AsString;

          isc_spb_sec_userId:
            FUserInfo[k].UserId := AsInteger;

          isc_spb_sec_groupid:
            FUserInfo[k].GroupID := AsInteger;

          else
            IBError(ibxeOutputParsingError, [getItemType]);
          end;
        end;
      end;
    else
      IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

function TIBSecurityService.GetUserInfo(Index: Integer): TUserInfo;
begin
  if Index <= High(FUSerInfo) then
    result := FUserInfo[Index]
  else
    result := nil;
end;

function TIBSecurityService.GetUserInfoCount: Integer;
begin
  Result := Length(FUserInfo);
end;

procedure TIBSecurityService.AddUser;
begin
  SecurityAction := ActionAddUser;
  ServiceStart;
end;

procedure TIBSecurityService.DeleteUser;
begin
  SecurityAction := ActionDeleteUser;
  ServiceStart;
end;

procedure TIBSecurityService.DisplayUsers;
begin
  SecurityAction := ActionDisplayUser;
  SRB.Add(isc_action_svc_display_user);
  InternalServiceStart;
  FetchUserInfo;
end;

procedure TIBSecurityService.DisplayUser(UserName: String);
begin
  SecurityAction := ActionDisplayUser;
  SRB.Add(isc_action_svc_display_user);
  SRB.Add(isc_spb_sec_username).AsString := UserName;
  InternalServiceStart;
  FetchUserInfo;
end;

procedure TIBSecurityService.ModifyUser;
begin
  SecurityAction := ActionModifyUser;
  ServiceStart;
end;

procedure TIBSecurityService.SetSecurityAction (Value: TSecurityAction);
begin
  FSecurityAction := Value;
  if Value = ActionDeleteUser then
    ClearParams;
end;

procedure TIBSecurityService.ClearParams;
begin
  FModifyParams := [];
  FFirstName := '';
  FMiddleName := '';
  FLastName := '';
  FGroupID := 0;
  FUserID := 0;
  FPassword := '';
end;

procedure TIBSecurityService.SetFirstName (Value: String);
begin
  FFirstName := Value;
  Include (FModifyParams, ModifyFirstName);
end;

procedure TIBSecurityService.SetMiddleName (Value: String);
begin
  FMiddleName := Value;
  Include (FModifyParams, ModifyMiddleName);
end;

procedure TIBSecurityService.SetLastName (Value: String);
begin
  FLastName := Value;
  Include (FModifyParams, ModifyLastName);
end;

procedure TIBSecurityService.SetPassword (Value: String);
begin
  FPassword := Value;
  Include (FModifyParams, ModifyPassword);
end;

procedure TIBSecurityService.SetUserId (Value: Integer);
begin
  FUserId := Value;
  Include (FModifyParams, ModifyUserId);
end;

procedure TIBSecurityService.SetGroupId (Value: Integer);
begin
  FGroupId := Value;
  Include (FModifyParams, ModifyGroupId);
end;

procedure TIBSecurityService.Loaded; 
begin
  inherited Loaded;
  ClearParams;
end;

procedure TIBSecurityService.SetServiceStartOptions;
var
  Len: UShort;

begin
  case FSecurityAction of
    ActionAddUser:
    begin
      Action := isc_action_svc_add_user;
      if ( Pos(' ', FUserName) > 0 ) then
        IBError(ibxeStartParamsError, [nil]);
      Len := Length(FUserName);
      if (Len = 0) then
        IBError(ibxeStartParamsError, [nil]);
      SRB.Add(isc_action_svc_add_user);
      SRB.Add(isc_spb_sec_username).AsString := FUserName;
      SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
      SRB.Add(isc_spb_sec_userid).AsInteger := FUserID;
      SRB.Add(isc_spb_sec_groupid).AsInteger := FGroupID;
      SRB.Add(isc_spb_sec_password).AsString := FPassword;
      SRB.Add(isc_spb_sec_firstname).AsString := FFirstName;
      SRB.Add(isc_spb_sec_middlename).AsString := FMiddleName;
      SRB.Add(isc_spb_sec_lastname).AsString := FLastName;
    end;
    ActionDeleteUser:
    begin
      Action := isc_action_svc_delete_user;
      Len := Length(FUserName);
      if (Len = 0) then
        IBError(ibxeStartParamsError, [nil]);
      SRB.Add(isc_action_svc_delete_user);
      SRB.Add(isc_spb_sec_username).AsString := FUserName;
      SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
    end;
    ActionModifyUser:
    begin
      Action := isc_action_svc_modify_user;
      Len := Length(FUserName);
      if (Len = 0) then
        IBError(ibxeStartParamsError, [nil]);
      SRB.Add(isc_action_svc_modify_user);
      SRB.Add(isc_spb_sec_username).AsString := FUserName;
      SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
      if (ModifyUserId in FModifyParams) then
        SRB.Add(isc_spb_sec_userid).AsInteger := FUserID;
      if (ModifyGroupId in FModifyParams) then
        SRB.Add(isc_spb_sec_groupid).AsInteger := FGroupID;
      if (ModifyPassword in FModifyParams) then
        SRB.Add(isc_spb_sec_password).AsString := FPassword;
      if (ModifyFirstName in FModifyParams) then
        SRB.Add(isc_spb_sec_firstname).AsString := FFirstName;
      if (ModifyMiddleName in FModifyParams) then
        SRB.Add(isc_spb_sec_middlename).AsString := FMiddleName;
      if (ModifyLastName in FModifyParams) then
        SRB.Add(isc_spb_sec_lastname).AsString := FLastName;
    end;
  end;
  ClearParams;
end;

{ TIBUnStructuredService }
constructor TIBControlAndQueryService.create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEof := False;
  FAction := 0;
end;

procedure TIBControlAndQueryService.SetAction(Value: Integer);
begin
  FEof := False;
  FAction := Value;
end;


function TIBControlAndQueryService.GetNextChunk: String;
var
  i: Integer;
begin
  if (FEof = True) then
  begin
    result := '';
    exit;
  end;
  if (FAction = 0) then
    IBError(ibxeQueryParamsError, [nil]);

  SRB.Add(isc_info_svc_to_eof);
  InternalServiceQuery;

  FEof := True;
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_to_eof:
        Result := AsString;

      isc_info_truncated:
        FEof := False;
    else
      IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

function TIBControlAndQueryService.WriteNextChunk(stream: TStream): integer;
var
  i: Integer;
begin
  result := 0;
  if (FEof = True) then
    exit;
  if (FAction = 0) then
    IBError(ibxeQueryParamsError, [nil]);

  SQPB.Add(isc_info_svc_timeout).AsInteger := 1;
  SRB.Add(isc_info_svc_to_eof);
  InternalServiceQuery;

  FEof := True;
  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_to_eof:
      begin
        Result := CopyTo(stream,0);
        FEof := Result = 0;
      end;

      isc_info_truncated:
        FEof := False;

      isc_info_svc_timeout:
        {ignore};
    else
      IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
end;

function TIBControlAndQueryService.GetNextLine: String;
var
  i: Integer;
begin
  Result := '';
  if (FEof = True) then
    exit;

  if (FAction = 0) then
    IBError(ibxeQueryParamsError, [nil]);

  SRB.Add(isc_info_svc_line);
  InternalServiceQuery;

  for i := 0 to FServiceQueryResults.Count - 1 do
  with FServiceQueryResults[i] do
  begin
    case getItemType of
      isc_info_svc_line:
         Result := AsString;
    else
      IBError(ibxeOutputParsingError, [getItemType]);
    end;
  end;
  FEOF := Result = '';
end;

{ TIBLogService }

procedure TIBLogService.SetServiceStartOptions;
begin
  Action := isc_action_svc_get_ib_log;
  SRB.Add(isc_action_svc_get_ib_log);
end;

{ TDatabaseInfo }

constructor TDatabaseInfo.Create;
begin
  DbName := nil;
end;

destructor TDatabaseInfo.Destroy;
begin
  DbName := nil;
  inherited Destroy;
end;

{ TLicenseInfo }

constructor TLicenseInfo.Create;
begin
  Key := nil;
  Id := nil;
  Desc := nil;
end;

destructor TLicenseInfo.Destroy;
begin
  Key := nil;
  Id := nil;
  Desc := nil;
  inherited Destroy;
end;

{ TConfigFileData }

constructor TConfigFileData.Create;
begin
  ConfigFileValue := nil;
  ConfigFileKey := nil;
end;

destructor TConfigFileData.Destroy;
begin
  ConfigFileValue := nil;
  ConfigFileKey := nil;
  inherited Destroy;
end;

{ TConfigParams }

constructor TConfigParams.Create;
begin
  ConfigFileData := TConfigFileData.Create;
  ConfigFileParams := nil;
end;

destructor TConfigParams.Destroy;
begin
  ConfigFileData.Free;
  ConfigFileParams := nil;
  inherited Destroy;
end;

end.
Revision:	80
Committed:	Mon Jan 1 11:31:07 2018 UTC (6 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	60346 byte(s)
Log Message:	Fixes merged into public release