Interbase Backup on the Fly in a thread

Problem/Question/Abstract:

In the Interbase Admin components there is a IBBackupService but is hard to use as it is. This component makes this alot easier, and also works in a thread.

Answer:

(*
  Interbase Backup Thread

  Author
    Kim Sandell
    Email: kim.sandell@nsftele.com

  Description
    A Thread that performs an backup of an interbase database on the fly.

  Version
    1.0

  History
    23.09.2002  - Initial version

  Known issues
    None so far ...

  Example of usage

    The example below assumes you have included the "IBBackupThread" unit
    in the uses clause, and that you have a button on a form.

    The example makes 10 fragments, each max 4 Megabytes. If the backup
    is larger, the last (10th fragment) will be bigger than 4 Megs.

    procedure TForm1.Button1Click(Sender: TObject);
    Var
       IBB: TIBBackupThread;
    begin
         IBB := NIL;
         Try
            IBB := TIBBackupThread.Create(True);
            IBB.Initialize;
            IBB.BackupPath := 'C:\Databases';
            IBB.DatabaseName := '127.0.0.1:C:\Databases\MyIBDB.GDB';
            IBB.DatabaseUsername := 'SYSDBA';
            IBB.DatabasePassword := 'masterkey';
            IBB.Fragments := 4;
            IBB.FragmentSizeK := 4096;
            IBB.Resume;
            While Not IBB.Terminated do
            Begin
                 SleepEx(1,True);
                 Application.ProcessMessages;
            End;
            IBB.WaitForAndSleep;
            If IBB.Success then
            Begin
                 MessageDlg('Backup OK',mtInformation,[mbOK],0);
                 ShowMessage( IBB.BackupLog.Text );
            End Else MessageDlg('Backup FAILED',mtError,[mbOK],0);
         Finally
            IBB.Free;
         End;
    end;
*)
unit IBBackupThread;

interface

uses
  Windows, Messages, SysUtils, Classes,
  IB, IBServices;

type
  TIBBackupThread = class(TThread)
  private
    { Private declarations }
  protected
    { Protected declarations }
    function BackupDatabase: Boolean;
  public
    { Public declarations }
    BackupOptions: TBackupOptions; // Backup Options
    BackupLog: TStringList; // A Stringlist with the results of the backup
    BackupPath: string; // Path on server
    DatabaseName: string; // Fully qualifyed name to db
    DatabaseUsername: string; // Username
    DatabasePassword: string; // Password
    Fragments: Cardinal; // How many backup files. 0 means 1 file.
    FragmentSizeK: Cardinal; // Max Size of a backup fragment in KByte
    Success: Boolean; // After operation, indicates Success or Fail

    property Terminated; // Make the Terminated published

    { Methods }
    procedure Initialize;
    destructor Destroy; override;
    procedure Execute; override;
    procedure WaitForAndSleep; // Special WaitFor that does not take 100% CPU
  published
    { Published declarations }
  end;

implementation

{ TIBBackupThread }

procedure TIBBackupThread.Initialize;
begin
  { Create variables }
  BackupLog := TStringList.Create;
  { Initialize default values }
  BackupPath := '';
  DatabaseName := '';
  DatabaseUsername := 'SYSDBA';
  DatabasePassword := '';
  Fragments := 0;
  FragmentSizeK := 0;
  Success := False;
  { Default to no options }
  BackupOptions := [];
end;

destructor TIBBackupThread.Destroy;
begin
  try
    { Free the result list }
    if Assigned(BackupLog) then
      BackupLog.Free;
  finally
    inherited;
  end;
end;

procedure TIBBackupThread.WaitForAndSleep;
var
  H: THandle;
  D: DWord;
begin
  { Get Handle }
  H := Handle;
  { Wait for it to terminate }
  repeat
    D := WaitForSingleObject(H, 1);
    { System Slizes }
    SleepEx(1, True);
  until (Terminated) or ((D <> WAIT_TIMEOUT) and (D <> WAIT_OBJECT_0));
end;

procedure TIBBackupThread.Execute;
begin
  try
    { Do not free it on termination }
    FreeOnTerminate := False;
    { Set lower priority }
    Priority := tpLower; // tpXXXXX variables
    try
      Success := BackupDatabase;
    finally
    end;
  except
  end;
  { Signal the termination of the Thread }
  Terminate;
end;

function TIBBackupThread.BackupDatabase: Boolean;
var
  IBBack: TIBBackupService;
  SrvAddr: string;
  DBPath: string;
  BakPath: string;
  BakName: string;
  I: Integer;

  { Leading Zero function }
  function Lz(Value: Cardinal; Digits: Byte): string;
  begin
    Result := IntToStr(Value);
    while Length(Result)
  end;

begin
  { Default Result }
  Result := False;
  try
    { Clear log }
    BackupLog.Clear;
    { Initialize Values }
    IBBack := nil;
    { Extract SrvAddr and DBPath from DatabaseName }
    BakPath := IncludeTrailingPathDelimiter(BackupPath);
    SrvAddr := DatabaseName;
    { Correct if Local machine }
    if Pos(':', SrvAddr) <> 0 then
    begin
      Delete(SrvAddr, Pos(':', SrvAddr), Length(SrvAddr));
      DBPath := DatabaseName;
      Delete(DBPath, 1, Pos(':', DBPath));
    end
    else
    begin
      { Must be localhost since Server Address is missing }
      SrvAddr := '127.0.0.1';
      DBPath := DatabaseName;
    end;
    { Make sure the Fragments & Size are is OK }
    if FragmentSizeK = 0 then
      Fragments := 0;
    if Fragments > 999 then
      Fragments := 999;
    if Fragments = 0 then
      FragmentSizeK := 0;
    try
      { Create the Backup service component }
      IBBack := TIBBackupService.Create(nil);
      IBBack.Protocol := TCP;
      IBBack.LoginPrompt := False;
      IBBack.Params.Values['user_name'] := DatabaseUsername;
      IBBack.Params.Values['password'] := DatabasePassword;
      IBBack.ServerName := SrvAddr;
      IBBack.DatabaseName := DBPath;
      IBBack.Options := BackupOptions;
      IBBack.Active := True;
      try
        IBBack.Verbose := True;
        { Add the Backup filenames }
        for I := 0 to Fragments do
        begin
          { Create the Backup filename }
          BakName := ExtractFileName(DBPath);
          Delete(BakName, Pos('.', BakName), Length(BakName));
          BakName := IncludeTrailingPathDelimiter(BackupPath) + BakName;
          { Check if we need to make a fragment file }
          if I = 0 then
          begin
            BakName := BakName + '_' + FormatDateTime('YYYYMMDD_HHNNSS', Now) +
              '.gbk';
            if (FragmentSizeK > 0) then
              BakName := BakName + ' = ' + IntToStr(FragmentSizeK * 1024);
          end
          else
          begin
            BakName := BakName + '_' + FormatDateTime('YYYYMMDD_HHNNSS', Now) + '.gbk_'
              + Lz(I, 3);
            if (FragmentSizeK > 0) then
              BakName := BakName + ' = ' + IntToStr(FragmentSizeK * 1024);
          end;
          { Add the Bakup name to the Filelist }
          IBBack.BackupFile.Add(BakName);
        end;
        { Start the Service }
        IBBack.ServiceStart;
        { Get the Resulting Report Lines }
        while not IBBack.Eof do
        begin
          BackupLog.Append(IBBack.GetNextLine);
          Sleep(1);
        end;
      finally
        { Turn the Backup service off }
        IBBack.Active := False;
      end;
      { Return results }
      Result := True;
    finally
      if Assigned(IBBack) then
      begin
        IBBack.Active := False;
        IBBack.Free;
      end;
    end;
  except
    on E: Exception do
      ; // Log error here
  end;
end;

end.