mybackup.pas

本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过

      FThisDiskIsNotTheFirstOne : String;
      FThePathDoesNotExist      : String;
      FCopyOf                   : String;
      FCouldNotWriteInFile      : String;
      FThisDiskContainsNoBackup : String;
      FWrongBackupSet           : String;
      FWrongBackupName          : String;
      FAborted                  : String;
      FReopeningTables          : String;
      FCompressingFile          : String;
      FUncompressingFile        : String;
      FNeedBackupName           : String;

      procedure AssignTo(Dest: TPersistent); override;

    public
      constructor Create;

      procedure SetLanguage( language : TLanguage );

    published
      property SystemMessage : String read FSystemMessage write FSystemMessage;
      property NeedValidDrivePath : String read FNeedValidDrivePath write FNeedValidDrivePath;
      property InsertDiskXInUnit : String read FInsertDiskXInUnit write FInsertDiskXInUnit;
      property DeletingFilesOfDrivePath : String read FDeletingFilesOfDrivePath write FDeletingFilesOfDrivePath;
      property AskForDeletionOfFiles : String read FAskForDeletionOfFiles write FAskForDeletionOfFiles;
      property CouldNotDeleteAllFiles : String read FCouldNotDeleteAllFiles write FCouldNotDeleteAllFiles;
      property ThisDiskIsNotTheFirstOne : String read FThisDiskIsNotTheFirstOne write FThisDiskIsNotTheFirstOne;
      property ThePathDoesNotExist : String read FThePathDoesNotExist write FThePathDoesNotExist;
      property CopyOf : String read FCopyOf write FCopyOf;
      property CouldNotWriteInFile : String read FCouldNotWriteInFile write FCouldNotWriteInFile;
      property ThisDiskContainsNoBackup : String read FThisDiskContainsNoBackup write FThisDiskContainsNoBackup;
      property WrongBackupSet : String read FWrongBackupSet write FWrongBackupSet;
      property WrongBackupName : String read FWrongBackupName write FWrongBackupName;
      property Aborted : String read FAborted write FAborted;
      property ReopeningTables : String read FReopeningTables write FReopeningTables;
      property CompressingFile : String read FCompressingFile write FCompressingFile;
      property UncompressingFile : String read FUncompressingFile write FUncompressingFile;
      property NeedBackupName : string read FNeedBackupName write FNeedBackupName;
  end;

  TMyBackup = class(TCustomCopyFile)
  private
  protected
    FDrivePath : String;
    FFilesPath : String;
    FBackupCaption : String;
    FRestoreCaption : String;
    FConfirmDelete : Boolean;
    FOperation : TOperation;
    FVersion : String;
    FID : String;
    FIdLabel : String;
    FBackupName : String;
    FDrive : Char;
    FUserName : String;
    FUserCompany : String;
    FUserLicence : String;
    FDiskCount : Integer;
    FCurrentFile : String;
    FInfosFileName : String;
    FOneMoreDisk : Boolean;
    FCurBackup : String;
    FFilesToBackup : TStringList; // Contains the list of the files to be backed up.
    FFilesRestored : TStringList; // Contains the list of the files restored.
    FMessages : TMessages;
    FLanguage : TLanguage;
    FOnDiskChanged:TNotifyEvent;
    FDisplayAbort : Boolean;
    FUseArchiver : Boolean;
    FArchiver : TArchiverInterface;

    procedure Finish; override;
    procedure SetFilesToBackup( val : TStringList );
    procedure SetFilesRestored( val : TStringList );
    procedure CheckDrive;
    procedure NextDisk;
    function  CheckDiskContent : Boolean;
    procedure CheckPath;
    procedure WriteFiles;
    procedure WriteFile( const FileName : String );
    procedure WriteInfos;
    procedure FileExtractedFromArchive( Sender : TObject; const FileName, DestPath : String; Size : Integer );
    procedure ReadFiles;
    procedure ReadFile( const FileName : String );
    procedure AskForDisk;
    procedure PrecalcDirSize( const dir : String ); override;
    procedure SetLanguage( lang : TLanguage );
    procedure SetMessages( msg : TMessages );
    procedure DoAbort;
    function  CreateArchiver : TArchiverInterface; virtual;
    function  GetArchiver : TArchiverInterface;
    function  GetTempDir : String;
    procedure AddFileEvent( Sender : TObject; const FileName : String; Size : Integer );
    procedure ExtractFileEvent( Sender : TObject; const FileName : String; Size : Integer );
    procedure FileProgressEvent( Sender : TObject; Percent : Integer );
    function  GetUseArchiver : Boolean;
    procedure Notification(AComponent: TComponent; Operation: Classes.TOperation); override;

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

    procedure Backup;
    procedure Restore;

    function  CheckFirstDisk : Boolean;
    function  GetInfos( SL : TStringList ) : Boolean;

  published
    property DrivePath : String read FDrivePath write FDrivePath;
    property FilesPath : String read FFilesPath write FFilesPath;
    property FilesToBackup : TStringList read FFilesToBackup write SetFilesToBackup;
    property FilesRestored : TStringList read FFilesRestored write SetFilesRestored;
    property BackupCaption : String read FBackupCaption write FBackupCaption;
    property RestoreCaption : String read FRestoreCaption write FRestoreCaption;
    property ConfirmDelete : Boolean read FConfirmDelete write FConfirmDelete default True;
    property Version : String read FVersion write FVersion;
    property ID : String read FID write FID;
    property IdLabel : String read FIdLabel write FIdLabel;
    property BackupName : String read FBackupName write FBackupName;
    property UserName : String read FUserName write FUserName;
    property UserCompany : String read FUserCompany write FUserCompany;
    property UserLicence : String read FUserLicence write FUserLicence;
    property InfosFileName : String read FInfosFileName write FInfosFileName;
    property Language : TLanguage read FLanguage write SetLanguage;
    property Messages : TMessages read FMessages write SetMessages;
    property DisplayAbort : Boolean read FDisplayAbort write FDisplayAbort;
    property UseArchiver : Boolean read GetUseArchiver write FUseArchiver;
    property Archiver : TArchiverInterface read FArchiver write FArchiver;
    Property OnDiskChanged:TNotifyEvent read FOnDiskChanged write FOnDiskChanged;

    // Properties herited and moved in the published section
    property Filter;
    property Progress;
    property Recursive;
    property OnStartOperation;
    property OnFinishOperation;
    property OnOperationProgress;
    property OnEachFile;
  end;


procedure Register;

implementation

uses FileCtrl, consts;

procedure Register;
begin
  RegisterComponents('Backup Tools', [TMyBackup]);
end;

////////////////////////////////////////////////////////////

procedure TArchiverInterface.SetFileName( const aFileName : String );
begin
end;

function  TArchiverInterface.GetFileName : String;
begin
  Result := '';
end;

procedure TArchiverInterface.SetExtractPath( const aPath : String );
begin
end;

function  TArchiverInterface.GetExtractPath : String;
begin
  Result := '';
end;

procedure TArchiverInterface.SetLanguage( lang : TLanguage );
begin
end;

function  TArchiverInterface.GetLanguage : TLanguage;
begin
  Result := lgEnglish;
end;

procedure TArchiverInterface.Open;
begin
end;

procedure TArchiverInterface.Close;
begin
end;

function  TArchiverInterface.AddFile( const aFileName : String ) : Boolean;
begin
  Result := False;
end;

function  TArchiverInterface.AddFiles( files : TStrings ) : Boolean;
begin
  Result := False;
end;

function  TArchiverInterface.AddDirectory( const Directory : String ) : Boolean;
begin
  Result := False;
end;

procedure TArchiverInterface.ExtractFiles;
begin
end;

procedure TArchiverInterface.SetRecursive( val : Boolean );
begin
end;

procedure TArchiverInterface.Delete;
begin
end;

////////////////////////////////////////////////////////////

procedure TMessages.AssignTo(Dest: TPersistent);
begin
  if Dest is TMessages then
    with TMessages( Dest ) do begin
      SystemMessage            := Self.SystemMessage;
      NeedValidDrivePath       := Self.NeedValidDrivePath;
      InsertDiskXInUnit        := Self.InsertDiskXInUnit;
      DeletingFilesOfDrivePath := Self.DeletingFilesOfDrivePath;
      AskForDeletionOfFiles    := Self.AskForDeletionOfFiles;
      CouldNotDeleteAllFiles   := Self.CouldNotDeleteAllFiles;
      ThisDiskIsNotTheFirstOne := Self.ThisDiskIsNotTheFirstOne;
      ThePathDoesNotExist      := Self.ThePathDoesNotExist;
      CopyOf                   := Self.CopyOf;
      CouldNotWriteInFile      := Self.CouldNotWriteInFile;
      ThisDiskContainsNoBackup := Self.ThisDiskContainsNoBackup;
      WrongBackupSet           := Self.WrongBackupSet;
      WrongBackupName          := Self.WrongBackupName;
      Aborted                  := Self.Aborted;
      ReopeningTables          := Self.ReopeningTables;
      FCompressingFile         := Self.FCompressingFile;
      FUncompressingFile       := Self.FUncompressingFile;
      FNeedBackupName          := Self.FNeedBackupName;
    end;
  inherited AssignTo( Dest );
end;

constructor TMessages.Create;
begin
  inherited;
  SetLanguage( lgEnglish );
end;

procedure TMessages.SetLanguage( language : TLanguage );
begin
  case language of
    lgEnglish:
      begin
        SystemMessage            := 'System Message';
        NeedValidDrivePath       := 'You must give a valid path to the backup drive';
        InsertDiskXInUnit        := 'Please, insert disk #%d in drive %s:';
        DeletingFilesOfDrivePath := 'Deleting files of backup drive...';
        AskForDeletionOfFiles    := 'Backup drive contains files. Do you want to delete them ?';
        CouldNotDeleteAllFiles   := 'Could not delete all files !';
        ThisDiskIsNotTheFirstOne := 'This disk is not the first of the backup disks set.';
        ThePathDoesNotExist      := 'The path "%s" does not exist';
        CopyOf                   := 'Copy of %s';
        CouldNotWriteInFile      := 'Could not write in file %s';
        ThisDiskContainsNoBackup := 'This disk does not contain any backup.';
        WrongBackupSet           := 'This disk does not belong to the backup set: %s';
        WrongBackupName          := 'This disk contains a backup of "%s" instead of "%s".';
        Aborted                  := 'Aborted!';
        ReopeningTables          := 'Reopening Tables...';
        CompressingFile          := 'Compression of %s';
        UncompressingFile        := 'Decompression of %s';
        NeedBackupName           := 'I need a name for the Backup (property BackupName)';
      end;
    lgFrench:
      begin
        SystemMessage            := 'Message syst鑝e';
        NeedValidDrivePath       := 'Vous devez fournir un chemin d''acc鑣 valide pour l''unit