mybackup.pas

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

unit MyBackup;
(*-----------------------------------------------------------------------------
  DESCRIPTION

  This component is freeware. You may use it, distribute it and modify it, but
  you may not charge for it.
  In case of modifications you must mail me ([e-mail]) a copy of
  the modifications. The reason are simple: Any changes that improve this free-
  ware component should be to benefit for everybody, not only you. That way you
  can be pretty sure, that this component has few errors and much functionality.
  In case of modifications, you will be on the credits list beneath:

  HISTORY

  Version 1.0 (25/06/97) by Morgan Martinet (France):

  This version is the base version.
  This Component lets you backup/restore a set of files in a directory. It will
  split the files if they don't fit in the Backup unit. I use this component
  with the Delphi Zip component that implements PK(UN)ZIP v2.04g, and it works
  perfectly ! So I first make a zipped archive of my directories and then
  I use MyBackup to to put this archives on disks because DelphiZip doesn't
  implement segmented archives.

  Properties:
    DrivePath       Sets the path of the backup unit (by default it is A:\)
    FilesPath       Sets the path from where the files will be backed up or
                      to where the files will be restored.
    BackupCaption   Sets a title for the Backup operation.
    RestoreCaption  Sets a title for the Restore operation.
    ConfirmDelete   Lets you specify if the user will be warned when the
                      component will need to erase the files of DrivePath.
    Version         Sets the Version of your software that did the
                      backup, in order to update your files if the backup is
                      older than the current version.
    ID              Sets a personal ID in order to identify the product that
                      did the backup and avoid restoring the backup of another
                      product.
    IdLabel         Sets a label for the Id of the Backup. This label will be
                      displayed when an Id's disk does not match the Id of
                      this component (cf. ID).
    BackupName      Sets a name for the backup.
    UserName        Sets the name of the registered user of your software in
                      order to check the origin of a backup.
    UserCompany     Sets the company of the registered user of your software
                      in order to check the origin of a backup.
    UserLicence     Sets the licence of the registered user of your software
                      in order to check the origin of a backup.
    InfosFileName   Sets the name of the file that contains the informations
                      about the backup and that will be written on each disk.
    Language        Sets the language used by the component
    Messages        String Messages used by the component
    DisplayAbort    if true, then it raises an exception with an abort message,
                    else it uses the delphi procedure Abort.
    OnDiskChanged   Event triggered when the disk is changed.
                    It lets you format the disk before anything is done for instance.

    Filter          Lets you filter the files from the FilesPath to be backed up.

    FilesToBackup   Lets you define a list of files or directories to be backed up,
                    instead of using the property FilesPath.

    FilesRestored   Contains the list of files that were restored.

    UseArchiver     If true, we use a TArchiverInterface for the backup.

    Archiver        Lets you connect the TMyBackup to a TArchiverInterface. You can then
                    define some options in the TArchiverInterface.
                    Otherwise, TMyBackup will create its own TArchiverInterface, but an
                    empty one ! So, use TMyArchBackup if you want TMyBackup to create
                    an interface with TArchiver, or drop a TArchiverInt and connect it
                    to the TMyBackup with the Archiver property of TMyBackup.
                    TArchiverInt will create automatically an instance of TArchiver,
                    but if you drop a TArchiver and you connect it to the TArchiverInt
                    with ist property Archiver, then TArchiverInt will use this component.
                    It's better if you want to customize TArchiver.
                    But, the best solution is to use directly TArchiver, because it does
                    all what TMyBackup does, but even better !!!!!
                    This was implemented if you don't want to change you settings, or
                    if you want to keep with DelZip.



  For this properties look at the comments in the CopyFile component
    Progress
    OnStartOperation
    OnFinishOperation
    OnOperationProgress
    OnEachFile

  Methods:
    Backup = start the backup process
    Restore = start the restore process
    CheckFirstDisk = check if the disk inserted contains
                     the first disk of a backup
    GetInfos = get the file that contains the informations
               about the backup into a list of strings (TStrings).
               You can then get the informations like:
               var
                 SL : TStringList;
               begin
                 SL := TStringList.Create;
                 try
                   if GetInfos( SL ) then
                     begin
                       version := SL.Values['Version'];
                       disk_num := StrToInt(SL.Values['Disk#']);
                       name := SL.Values['Backup.Name'];
                     end
                   else
                     // error !
                 finally
                   SL.Free;
                 end;
               end;
  ----------------------------------------------------------------------------
  Version 1.1 (09/10/97) Morgan Martinet (France):

  Added property Filter in order to filter the files of the FilesPath to be
        backed up.
  Added property FilesToBackup (StringList) in order to backup a list of files
        instead of the content of the FilesPath directory.
  Added property FilesRestored (StringList) in order to know which files
        were restored.
  Modified Backup procedure: if the FilesToBackup list is not empty, we use
        this list in order to do the backup, otherwise we use the files of the
        FilesPath directory.
  Modified Restore procedure: we update the FilesRestored list, as we restore
        a new file.
  ----------------------------------------------------------------------------
  Version 1.2 (03/26/98) by Huanlin Tsai (Taiwan).
    E-Mail: [e-mail]  or  [e-mail]

  - Added traditional Chinese messages.
  - DrivePath now can be a hard disk path (ex: c:\data\) and will auto detect
    if need asking insert disk #.
  - Calls to 'Abort' are replaced by 'raise Exception.Create(sAborted)'.
  - Bugs found in procedure 'CheckDrive' and 'CheckFirstDisk':
    When restoring files and drive A:\ has a disk which is not the first disk,
    after asking 'Insert disk #1 to drive A:\', the user can't choose 'Cancel'
    to abort the operation, it just keep on asking. The bug is fixed now.
  - Local 'AskForDisk' procedures are moved out as one procedure.
  - Some comments and code style are slightly changed (sorry if ugly!).
  - Added a Demo project
  ----------------------------------------------------------------------------
  Version 1.3 (08/04/98) Morgan Martinet (France):
  - Fixed a bug when using a list of files to backup, the component
    did calc the size of the content of the directory instead of the sum
    of the size of the files in the list (see procedure PrecalcDirSize).
  - Fixed a bug that prevented from showing the Backup/Restore caption
  - Fixed a bug that calced the size of the directory and its subdirectories
    instead of only calculate the size of the directory, because we don't
    backup the subdirectories.
  - Extended the Demo application
  ----------------------------------------------------------------------------
  Version 1.4 (01/06/98) Morgan Martinet (France):
  - Added class TMessages that stores the string messages used by the
    component, and the different translations.
  - Added property Language, that lets you select a specific language
    (It's an idea of Oliver Buschjost).
  - Added property Messages that lets you redefine the messages used by
    the component, for a language that's not already known.
  - Added event OnDiskChanged triggered after that the disk has changed,
    but before that the content is checked for deletion.
    It's an idea of Hugo Souza ([e-mail])
  - Added Portuguese thanks to Hugo Souza ([e-mail])
  ----------------------------------------------------------------------------
  Version 1.5 (02/06/98) Morgan Martinet (France):
  - Forgot to free the object TMessage !
  - changed SetLanguage: do not call FMessages.SetLanguage when the component
    is loading because it would overwrite the changes to the messages made
    by the user.
  - Added German thanks to Oliver Buschjost ([e-mail])
  - Added property DisplayAbort: if true, then it raises an exception with
    an abort message, else it uses the delphi procedure Abort.
  ----------------------------------------------------------------------------
  Version 1.6 (10/06/98) Morgan Martinet (France):
  - Used a TFileStream instead of Basic IO. It resolves the
    difference between Delphi2 and Delphi3.
  - Fixed a bug : when backing up, if we swap the current disk while writing
    a file, and if the disk content must be deleted, then the message progress
    would display "deleting files...", and not restore to "copying file...".
  - Fixed a bug : bad progress ratio when restoring files
  - Fixed a bug : when the file was split, the restore process did open
    the file and seek to the end, but if the file did already exist,
    it made it bigger than it should !
    The trick : we store each file restored in FilesRestored, so before
    we try to open the destination file, we check if it already exists
    in this list: if yes, it means that we already started restoring it,
    so we do nothing. Else, we delete it, so we can garantee that appending
    to this file started with an empty file.
  - Do not copy the infos.txt file when restoring files.
  - Added TArchiver support:
    You allow the Archiver use with the property UseArchiver.
    You can give your TArchiver to TMyBackup with the property Archiver.
    When MyBackup needs an archiver (GetArchiver), it will look if this property is set,
    else it will create its own with (CreateArchiver a virtual method, so you can
    create any of the descendants of TArchiver).
    It's usefull to connect your MyBackup on a TArchiver that you dropped on
    the form, because you can define some options and some events (MyBackup
    uses the events OnAddFile, OnExtractFile, OnFileProgress and OnFileExtracted,
    so don't try to define them, they will be overwritten).
  ----------------------------------------------------------------------------
  Version 1.7 (10/08/98) Morgan Martinet (France):
  - Added property ArchiverOptions if you need to define some options
    of the TArchiver component. You can deactivate the compression,
    or activate the encryption for instance.
  - Added italian language thanks to Gabriele Bigliardi ([e-mail])
  ----------------------------------------------------------------------------
  Version 1.8 (24/11/98) Morgan Martinet (France):
  - Removed direct reference to my component TArchiver. I replaced it with
    a component wrapper (TArchiverInterface) that contains only virtual methods.
    So, you can derive it in order to interface it with some other components
    that makes archives, like DelZip or mine.


-----------------------------------------------------------------------------*)

interface

uses
  Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
  CopyFile, Classes;


const
  kMinDiskSpace = 1024*8;
  kInfosFile = 'infos.txt';

type
  TOperation = (opBackup, opRestore, opNone);

  TLanguage = (lgEnglish, lgFrench, lgChinese, lgPortuguese,
               lgGerman, lgItalian, lgSpanish);

  TOnExtractFileEvent = procedure ( Sender : TObject; const FileName : String; Size : Integer ) of Object;
  TOnAddFileEvent = procedure ( Sender : TObject; const FileName : String; Size : Integer ) of Object;
  TOnFileExtractedEvent = procedure ( Sender : TObject; const FileName, DestPath : String; Size : Integer ) of Object;
  TOnFileProgress = procedure ( Sender : TObject; percent : Integer ) of Object;

  TArchiverInterface = class(TComponent)
  protected
    FOnExtractFile : TOnExtractFileEvent;
    FOnAddFile : TOnAddFileEvent;
    FOnFileExtracted : TOnFileExtractedEvent;
    FOnFileProgress : TOnFileProgress;

    procedure SetFileName( const aFileName : String ); virtual;
    function  GetFileName : String; virtual;
    procedure SetExtractPath( const aPath : String ); virtual;
    function  GetExtractPath : String; virtual;
    procedure SetLanguage( lang : TLanguage );
    function  GetLanguage : TLanguage;
  public
    procedure Open; virtual;
    procedure Close; virtual;
    function  AddFile( const aFileName : String ) : Boolean; virtual;
    function  AddFiles( files : TStrings ) : Boolean; virtual;
    function  AddDirectory( const Directory : String ) : Boolean; virtual;
    procedure ExtractFiles; virtual;
    procedure SetRecursive( val : Boolean ); virtual;
    procedure Delete; virtual;

    property FileName : String read GetFileName write SetFileName;
    property ExtractPath : String read GetExtractPath write SetExtractPath;
    property Language : TLanguage read GetLanguage write SetLanguage;
    property OnExtractFile : TOnExtractFileEvent read FOnExtractFile write FOnExtractFile;
    property OnAddFile : TOnAddFileEvent read FOnAddFile write FOnAddFile;
    property OnFileExtracted : TOnFileExtractedEvent read FOnFileExtracted write FOnFileExtracted;
    property OnFileProgress : TOnFileProgress read FOnFileProgress write FOnFileProgress;
  end;

  TMessages = class(TPersistent)
    protected
      FSystemMessage            : String;
      FNeedValidDrivePath       : String;
      FInsertDiskXInUnit        : String;
      FDeletingFilesOfDrivePath : String;
      FAskForDeletionOfFiles    : String;
      FCouldNotDeleteAllFiles   : String;