Title: Interbase Backup on the Fly in a thread
Question: 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@celarius.com
Description
A Thread that performs an backup of an interbase database on the fly.
History
23.09.2002 - Initial version
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 ((DWAIT_TIMEOUT) AND (DWAIT_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) Digits do
Result := '0'+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 Fragments999 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 (FragmentSizeK0) then BakName := BakName+' = '+IntToStr(FragmentSizeK*1024);
End Else
Begin
BakName := BakName+'_'+FormatDateTime('YYYYMMDD_HHNNSS',Now)+'.gbk_'+Lz(I,3);
If (FragmentSizeK0) 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.