Interbase Backup on the Fly in a thread (Views: 30)
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. |