Interbase Object for executing all the Interbase commands at Run time

Problem/Question/Abstract:

How can I create Interbase database at run time? How can I change Interbase database password/user without using Interbase utilities?

Answer:

If an application runs on an interbase database, the database and all the required objects such as functions, stored procedures etc. has to be created before running the application.

And some of the commands such as changing the Administrators name and password has to be done either using Server manager of Interbase or by the command line utilities supplied by Interbase.

By including this unit in the project, You can execute all the required commands such as creating a database, changing the administrators password, creating shadows, functions, procedures etc.

Make sure that this object is created first in your application. In your project source file the unit "Object_Interbase" must be the first unit to follow after the standard units used by the application.

Include the Object_Interbase unit in your unit's uses cluase from which you are going to use the object. You will be able to get the variable named "ThisDataBase" of Class TMyIbDataBase which we will be using to executing the Interbase commands.

//*** THE UNIT STARTS HERE

unit Object_Interbase;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, IBDataBase, IBQuery, FileCtrl;

type
  TShadow = (stManual, stAuto, stConditional);

  TMyIbDataBase = class(TObject)
  private
    //User Defined Type Variable

    FShdType: TShadow;

    //Components Variables
    FDataBase: TIBDatabase;
    FTransaction: TIBTransaction;
    FQuery: TIBQuery;

    //Boolean Variables
    FUseDefaultFiles: Boolean;
    FConnected: Boolean;
    FShadow: Boolean;

    //String Variables
    FIBServerPath: string;
    FDataBasePath, FShadowPath: string;
    FUser, FPassword: string;
    FDatabaseName: string;

    //Procedures
    procedure CheckDirPath(var Value: string);
    procedure ChangetoIBDir;
    procedure CreateComponents;
    procedure InitilizeVariables;
    procedure IBLoadpathfromRegistry;
    procedure SetDataBasePath(Value: string);
    procedure SetShadowPath(Value: string);
    procedure SetAdminName(Value: string);
    procedure SetAdminPassword(Value: string);
    procedure SetDatabaseName(Value: string);
    procedure SetShadow(Value: Boolean);
    procedure SetShadowType(Value: TShadow);
  protected
  public
    constructor Create;

    //Procedures
    procedure IBCreateDatabase;
    procedure IBConnectToDatabase;
    procedure IBDisConnecFromDatabase;
    procedure IBCreateShadow;
    procedure IBQueryAssisnSQL(Value: string; CloseAfterExecution: Boolean);
    procedure IBChangeAdminPassword(Value: string);

    //Component Properties
    property IBAppDatabase: TIBDatabase read FDataBase;
    property IBAppTransaction: TIBTransaction read FTransaction;
    property IBAppQuery: TIBQuery read FQuery;

    //User Defined Type Properties
    property IBShadowType: TShadow read FShdType write SetShadowType;

    //Boolean value Properties
    property IBConnected: Boolean read FConnected default False;
    property IBExists: Boolean read FUseDefaultFiles default False;
    property IBShadow: Boolean read FShadow write SetShadow default False;

    //String Value Properties
    property IBServerPath: string read FIBServerPath;
    property IBUserName: string read FUser write SetAdminName;
    property IBPassword: string read FPassword write SetAdminPassword;
    property IBDatabasePath: string read FDataBasePath write SetDataBasePath;
    property IBShadowPath: string read FShadowPath write SetShadowPath;
    property IBDatabaseName: string read FDatabaseName write SetDatabaseName;
  end;

var
  ThisDataBase: TMyIbDataBase;

implementation

{ TIbDataBase }

procedure TMyIbDataBase.CheckDirPath(var Value: string);
begin
  if Value[Length(Value)] <> '\' then
    Value := Value + '\';
  if not DirectoryExists(Value) then
  begin
    CreateDir(Value);
  end;
end;

procedure TMyIbDataBase.IBChangeAdminPassword(Value: string);
var
  I: Integer;
begin
  ThisDataBase.ChangetoIBDir;
  I := WinExec(pchar('gsec -user ' + ThisDataBase.IBUserName +
    ' -password ' + ThisDataBase.IBPassword +
    ' -mo ' + ThisDataBase.IBUserName + ' -pw ' +
    Value), 0);
  ThisDataBase.IBPassword := Value;
end;

procedure TMyIbDataBase.ChangetoIBDir;
begin
  if ThisDataBase.IBExists then
    ChDir(ThisDataBase.IBServerPath);
end;

procedure TMyIbDataBase.IBConnectToDatabase;
begin
  if not ThisDataBase.IBConnected then
  begin
    FDataBase.Close;
    FDataBase.SQLDialect := 1;
    FTransaction.Active := False;
    FQuery.Close;
    FDataBase.LoginPrompt := False;
    FDataBase.Params.Clear;
    FDataBase.Params.Add('USER_NAME=' + ThisDataBase.IBUserName);
    FDataBase.Params.Add('PASSWORD=' + ThisDataBase.IBPassword);
    FDataBase.DatabaseName := ThisDataBase.IBDatabasePath + IBDatabaseName;
    try
      FDataBase.Connected := True;
      FTransaction.DefaultDatabase := FDataBase;
    except
    end;
    FConnected := FDataBase.Connected;
    FQuery.Transaction := FTransaction;
    FQuery.Database := FDataBase;
    FDataBase.DefaultTransaction := FTransaction;
    if FConnected then
    begin
      FTransaction.Active := True;
    end;
  end;
end;

constructor TMyIbDataBase.Create;
begin
  CreateComponents;
  InitilizeVariables;
  IBLoadpathfromRegistry;
end;

procedure TMyIbDataBase.CreateComponents;
begin
  FDataBase := TIBDatabase.Create(Application);
  FTransaction := TIBTransaction.Create(Application);
  FDataBase.DefaultTransaction := FTransaction;
  FTransaction.DefaultDatabase := FDataBase;
  FQuery := TIBQuery.Create(Application);
  FQuery.Database := FDataBase;
  FQuery.Transaction := FTransaction;
  FQuery.ParamCheck := False;
end;

procedure TMyIbDataBase.IBCreateDatabase;
var
  vmem: TStringList;
  S: string;
begin
  S := ExtractFilePath(Application.ExeName);
  vmem := TStringList.Create;
  vmem.Add('Create database "' + ThisDataBase.IBDatabasePath +
    ThisDataBase.IBDatabaseName +
    '" user "' + ThisDataBase.IBUserName + '" password "' +
    ThisDataBase.IBPassword + '" page_size=2048 Length=50;');
  vmem.Add('Commit work;');
  vmem.Add('gfix -w "sync" -user "' + ThisDataBase.IBUserName + '" -pa ' +
    ThisDataBase.IBPassword + '" "' + ThisDataBase.IBDatabasePath +
    ThisDataBase.IBDatabaseName + '"');
  S := S + 'Sql03EASY05.Sql';
  vmem.SaveToFile(S);
  vmem.Free;
  ThisDataBase.ChangetoIBDir;
  S := 'isql -input ' + S;
  winexec(pchar(S), 0);
  DeleteFile(S);
  S := ThisDataBase.IBDatabasePath + ThisDataBase.IBDatabaseName;
  while not FileExists(S) do
    ;
  ThisDataBase.IBConnectToDatabase;
  FConnected := FDataBase.Connected;
end;

procedure TMyIbDataBase.IBCreateShadow;
var
  S, vFname: string;
begin
  if ThisDataBase.IBConnected then
  begin
    case FShdType of
      stAuto: S := 'Auto';
      stManual: S := 'Manual';
      stConditional: S := 'Conditional';
    end;
    vFname := Copy(FDatabaseName, 1, pos('.', FDatabaseName)) + 'Shd';
    FQuery.Close;
    FQuery.SQL.Clear;
    FQuery.SQL.Text := 'Create Shadow 1 ' + S + ' "' + FShadowPath +
      vFname + '" Length = 10000';
    FQuery.ExecSQL;
    Application.ProcessMessages;
  end;
end;

procedure TMyIbDataBase.InitilizeVariables;
begin
  FDataBasePath := '';
  FShadowPath := '';
  FIBServerPath := '';
  FUser := '';
  FPassword := '';
  FDatabaseName := '';
  FShdType := stConditional;
  FConnected := False;
end;

procedure TMyIbDataBase.IBLoadpathfromRegistry;
var
  vReg: TRegistry;
begin
  vReg := TRegistry.Create;
  vReg.RootKey := HKEY_LOCAL_MACHINE;
  if vReg.OpenKey('\Software\InterBase Corp\InterBase\CurrentVersion', False) then
  begin
    FIBServerPath := vreg.ReadString('ServerDirectory');
    FUseDefaultFiles := True;
  end
  else
  begin
    FIBServerPath := ExtractFilePath(Application.ExeName);
    FUseDefaultFiles := False;
  end;
  vReg.CloseKey;
  vReg.Free;
end;

procedure TMyIbDataBase.SetAdminName(Value: string);
begin
  if (Value <> FUser) then
    FUser := Value;
end;

procedure TMyIbDataBase.SetAdminPassword(Value: string);
begin
  if (Value <> FPassword) then
    FPassword := Value;
end;

procedure TMyIbDataBase.SetDatabaseName(Value: string);
begin
  if (Value <> FDatabaseName) then
    FDatabaseName := Value;
end;

procedure TMyIbDataBase.SetDataBasePath(Value: string);
begin
  if (Value <> FDataBasePath) then
  begin
    FDataBasePath := Value;
    CheckDirPath(FDataBasePath);
  end;
end;

procedure TMyIbDataBase.SetShadow(Value: Boolean);
begin
  if (Value <> FShadow) then
    FShadow := Value;
end;

procedure TMyIbDataBase.SetShadowPath(Value: string);
begin
  if (Value <> FShadowPath) then
  begin
    FShadowPath := Value;
    CheckDirPath(FShadowPath);
  end;
end;

procedure TMyIbDataBase.SetShadowType(Value: TShadow);
begin
  if (Value <> FShdType) then
    FShdType := Value;
end;

procedure TMyIbDataBase.IBQueryAssisnSQL(Value: string; CloseAfterExecution: Boolean);
begin

  FQuery.Close;
  FQuery.SQL.Clear;
  FQuery.SQL.Text := Value;
  try
    FQuery.ExecSQL;
  except
  end;
  if CloseAfterExecution then
  begin
    FQuery.Close;
    FQuery.SQL.Clear;
    FQuery.SQL.Text := 'Commit';
    FQuery.ExecSQL;
    FQuery.Close;
  end;
end;

procedure TMyIbDataBase.IBDisConnecFromDatabase;
begin
  FDataBase.CloseDataSets;
  FDataBase.ForceClose;
  FConnected := FDataBase.Connected;
end;

initialization
  if (ThisDataBase = nil) then
    ThisDataBase := TMyIbDataBase.Create;
finalization
  if (ThisDataBase <> nil) then
  begin
    ThisDataBase.Free;
    ThisDataBase := nil;
  end;
end.

//** THE UNIT ENDS HERE

Examples:

1. Creating a Database

If you want to create a database called "Sample.Gdb" in the directory called "c:\test\" with the administrator named
"LION" with the password "king". Just by using the properties and methods of this simple object we can create the database.

ThisDataBase.IBUserName := 'LION';
ThisDataBase.IBPassword := 'king';
ThisDataBase.IBDatabasePath := 'c:\test\';
ThisDataBase.IBDatabaseName := 'Sample.Gdb';
ThisDataBase.IBCreateDatabase;

The properties IBUserName, IBPassword, IBDatabaseName has to be assigned only once.

2. Creating Shadow

ThisDataBase.IBConnectToDatabase;
ThisDatabse.IBShadowType := stAuto;
ThisDatabse.IBCreateShadow;

3. Changing Database Password

ThisDataBase.IBChangeAdminPassword('NewPassword');

4. Creating a Table

ThisDatabase.IBQueryAssisnSQL('CREATE TABLE USERS(                    ' +
  'USERCODE      VARCHAR(6)  NOT NULL   , ' +
  'USERNAME      VARCHAR(20) NOT NULL   , ' +
  'USERACTIVE    VARCHAR(1)  DEFAULT "Y", ', True);

In the same way you can assign the scripts for creating the stored procedures, function and the scripts for creating all the objects using this method.

5. The properties  IBAppDatabase, IBAppTransaction and IBAppQuery can be used to assign to the properties of the IBTable component if you are go to work with the IBTable component.

If in case you are not going to work with the Interbase components this object can be modifed to work with the simple database components.