archiverroot.pas

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

unit ArchiverRoot;
{
  TArchiver by Morgan Martinet (C) 1998 - [e-mail] or [e-mail]

  COPYRIGHT
  ---------

  This component is email-ware. You may use it, distribute it and modify it, but
  you may not charge for it. Please send me a mail if you use it, I'll be happy
  to see in which country it is used, and I'll be able to mail you the updates.

  In case of modifications you must mail me 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.

  DESCRIPTION
  -----------

  This component lets you add/extract files to/from an archive.

}

interface

uses
  Windows,
  SysUtils,
  Classes,
  ArchiverMisc;

const
  kVersion = 1;
  kMaxCryptBuffer = 8;
  kMinKeySize = 10;
  kDefaultExt = '.mmm';

type
  TUserData = packed record
    UserName         : String[20];
    Company          : String[20];
    SerialNumber     : String[20];
    BackupName       : String[20];
    Date             : TDateTime;
    ProductId        : Integer;
    ProductVersion   : Integer;
    Free             : array [0..31] of Byte; // Free space for you
  end;
  PUserData = ^TUserData;

  TArchiveSize = Extended;
  TFileSize = Integer;

  TDataInfo = packed record
    FileCount      : Integer;
    Size           : TArchiveSize;
    CompressedSize : TArchiveSize;
  end;

  TArchiveFlag = set of (afCrypted, afCompressed, afSolid, afReadOnly, afFinalSegment);

  TArchiveHeader = packed record
    Signature             : Integer;
    Version               : Integer;
    RandomID              : Integer; // Used to check the segments
    BlockSize             : Integer;
    EndOffset             : Integer;
    Segment               : Word;
    ArchiveFlag           : TArchiveFlag;
    ArchiveInfo           : TDataInfo; // Infos about the whole archive
    SegmentInfo           : TDataInfo; // Infos about the current segment only
    UserData              : TUserData;
    Reserved              : array [0..63] of Byte;
    Comment               : String;
  end;

  TFileInfo = packed record
    Size            : Integer;
    CompressedSize  : Integer;
  end;

  TFileFlag = set of (ffFile, ffEmptyFolder, ffFinalSegment, ffCrypted, ffPatch);

  TFileEntry = packed record
    Name             : String;
    Date             : TDateTime;
    Attr             : Integer;
    Segment          : Word;       // First segment containing this file
    Offset           : Integer;    // Offset to the file in the current segment
    FileOffset       : Integer;    // Offset in the source file beeing archived
    FileFlag         : TFileFlag;
    ArchiveInfo      : TFileInfo;  // Informations for the whole file stored in the archive
    SegmentInfo      : TFileInfo;  // Informations on the part of this file stored in the current segment
  end;
  PFileEntry = ^TFileEntry;

  TFileObject = class
  public
    FileEntry : TFileEntry;
    DirectoryIndex : Integer;    // Used only by WinArchiver
    ImageIndex : Integer;        // Used only by WinArchiver
    StateIndex : Integer;        // Used only by WinArchiver
    Tag : Integer;               // Free for your own use
  end;

  TErrorAction = (eaContinue, eaAbort, eaAsk);
  TOperation = (opNone, opAdd, opExtract, opEnumerate, opDelete, opMakeSFX, opCheck);
  TInternalOperationEnum = (ioCompressingStream, ioUncompressingStream,
                            ioSkippingStream, ioSwappingSegment,
                            ioOpening, ioClosing, ioOpenSolid, ioCloseSolid,
                            ioEnumAfterOpen);
  TInternalOperation = set of TInternalOperationEnum;
  TOption = (oStoreEmptyFolders, oShowEmptyFolders, oCreateReadOnly,
             oCreateSolidArchives, oCompress, oCrypt, oEraseFirstDisk,
             oEraseNewDisk, oConfirmFileDeletion, oEnumerateAfterOpen,
             oIncludeStartingDirectory, oRecurseFolders, oOpenSingleSegment,
             oRestorePath, oSecureAccess, oWriteSFXCode, oEncryptFiles,
             oMaintainFileDirectory, oNoSpanning);

  TOptions = set of TOption;
  TLanguage = (lgAutomatic, lgEnglish, lgFrench, lgChinese, lgPortuguese,
               lgGerman, lgItalian, lgRussian, lgSpanish);

  TMySelectDirOpt = (sdAllowCreate, sdPerformCreate, sdPrompt);
  TMySelectDirOpts = set of TMySelectDirOpt;

  TOnFileProgressEvent      = procedure ( Sender : TObject; Percent : Integer ) of Object;
  TOnErrorEvent             = procedure ( Sender : TObject; E : Exception; const FileEntry : TFileEntry;
                                          var ErrorAction : TErrorAction ) of Object;
  TOnAcceptArchiveEvent     = procedure ( Sender : TObject; const Header : TArchiveHeader; var Accept : Boolean ) of Object;
  TOnWriteUserDataEvent     = procedure ( Sender : TObject; var UserData : TUserData ) of Object;
  TOnEnterCryptKeyEvent     = procedure ( Sender : TObject; var Key : String ) of Object;
  TOnRequestCryptKeyEvent   = procedure ( Sender : TObject; var Key : String ) of Object;
  TOnGetSignatureEvent      = procedure ( Sender : TObject; var Signature : Integer ) of Object;
  TOnShowCommentEvent       = procedure ( Sender : TObject; const Comment : String ) of Object;
  TOnShowTimingEvent        = procedure ( Sender : TObject; ElapsedTime, RemainingTime : TDateTime ) of Object;
  TOnDisplayMessageEvent    = procedure ( Sender : TObject; const msg : String ) of Object;
  TOnAddToLogEvent          = procedure ( Sender : TObject; const msg : String ) of Object;

  EArchiver = class( Exception );

  TMessages = class(TPersistent)
    protected
      FLanguage : TLanguage;
      FBadSignature : String;
      FFileNameNeeded : String;
      FSystemMessage : String;
      FAcceptArchiveFailed : String;
      FEnterCryptKey : String;
      FEnterDecryptKey : String;
      FKeyTooShort : String;
      FConfirmCryptKey : String;
      FKeyNotConfirmed : String;
      FArchiveIsReadOnly : String;
      FCanNotCreateArchive : String;
      FCannotCreateDir : String;
      FSelectADirectory : String;
      FOk : String;
      FCancel : String;
      FInformation : String;
      FWarning : String;
      FConfirmation : String;
      FError : String;
      FCanNotBuildTempFileName : String;
      FYes : String;
      FYesToAll : String;
      FNo : String;
      FFile : String;
      FCanContinue : String;
      FUnknownVersion : String;

      procedure AssignTo(Dest: TPersistent); override;
      procedure PropSetLanguage( language : TLanguage );
      procedure SetLanguage( language : TLanguage ); virtual;
      procedure SetGlobalStrings; virtual;

    public
      constructor Create;

      property Language : TLanguage read FLanguage write PropSetLanguage;

    published
      property BadSignature : String read FBadSignature write FBadSignature;
      property FileNameNeeded : String read FFileNameNeeded write FFileNameNeeded;
      property SystemMessage : String read FSystemMessage write FSystemMessage;
      property AcceptArchiveFailed : String read FAcceptArchiveFailed write FAcceptArchiveFailed;
      property EnterCryptKey : String read FEnterCryptKey write FEnterCryptKey;
      property EnterDecryptKey : String read FEnterDecryptKey write FEnterDecryptKey;
      property KeyTooShort : String read FKeyTooShort write FKeyTooShort;
      property ConfirmCryptKey : String read FConfirmCryptKey write FConfirmCryptKey;
      property KeyNotConfirmed : String read FKeyNotConfirmed write FKeyNotConfirmed;
      property ArchiveIsReadOnly : String read FArchiveIsReadOnly write FArchiveIsReadOnly;
      property CanNotCreateArchive : String read FCanNotCreateArchive write FCanNotCreateArchive;
      property CannotCreateDir : String read FCannotCreateDir write FCannotCreateDir;
      property SelectADirectory : String read FSelectADirectory write FSelectADirectory;
      property Ok : String read FOk write FOk;
      property Cancel : String read FCancel write FCancel;
      property Information : String read FInformation write FInformation;
      property Warning : String read FWarning write FWarning;
      property Confirmation : String read FConfirmation write FConfirmation;
      property Error : String read FError write FError;
      property CanNotBuildTempFileName : String read FCanNotBuildTempFileName write FCanNotBuildTempFileName;
      property Yes : String read FYes write FYes;
      property YesToAll : String read FYesToAll write FYesToAll;
      property No : String read FNo write FNo;
      property AFile : String read FFile write FFile;
      property CanContinue : String read FCanContinue write FCanContinue;
      property UnknownVersion : String read FUnknownVersion write FUnknownVersion;
    end;

  TArchiverRoot = class( TComponent )
  protected
    FHeader : TArchiveHeader;
    FFileName : String;
    FStream : TStream;
    FFilter : String;
    FBytesToProcess : TArchiveSize; // Used for calculating a progress ratio
    FBytesProcessed : TArchiveSize; // Used for calculating a progress ratio
    FPercent : Integer; // progress ratio
    FStartCount : Integer;     // Number of call of the Start/Finish methods
    FBlockSize : Integer;
    FSrcBlock : PChar;
    FDestBlock : PChar;
    FErrorAction : TErrorAction;
    FCurrentFileEntry : TFileEntry;
    FCurrentFileIdx : Integer;
    FOperation : TOperation;
    FMessages : TMessages;
    FMaxSegmentSize : Integer;
    FCheckAvailableSpace : Boolean;
    FInternalOperation : TInternalOperation;
    FArchiveDrive : String;
    FArchiveName : String;
    FArchiveDir : String;
    FArchiveExt : String;
    FCompressedArchiveSize : TArchiveSize; // Used for progress
    FIsOpen : Boolean;
    FCryptKey : String;
    FReadOnly : Boolean;
    FStartOffset : Integer;
    FOptions : TOptions;
    FOldFileName : String;
    FOldOptions : TOptions;
    FOldMaxSegmentSize : Integer;
    FSegmentNeeded : Integer;
    FSFXCodeSize : Integer;
    FIsSolidArchive : Boolean;
    FTmpFileDate : TDateTime;
    FAlwaysContinue : Boolean;
    FFiles : TList;
    FArchiveChanged : Boolean;
    FMustAbort : Boolean;
    // Timing informations
    FStartTime : TDateTime;
    FEndTime : TDateTime;
    FBytesPerMSec : Extended;
    FLastTicks : Integer;
    FTotTicks : Integer;

    // Events
    FOnFileProgress : TOnFileProgressEvent;
    FOnStartOperation : TNotifyEvent;
    FOnFinishOperation : TNotifyEvent;
    FOnError : TOnErrorEvent;
    FOnAcceptArchive : TOnAcceptArchiveEvent;
    FOnWriteUserData : TOnWriteUserDataEvent;
    FOnEnterCryptKey : TOnEnterCryptKeyEvent;
    FOnRequestCryptKey : TOnRequestCryptKeyEvent;
    FOnBeforeOpen : TNotifyEvent;
    FOnAfterOpen : TNotifyEvent;
    FOnBeforeClose : TNotifyEvent;
    FOnAfterClose : TNotifyEvent;
    FOnGetSignature : TOnGetSignatureEvent;
    FOnAfterHeaderUpdate : TNotifyEvent;
    FOnShowComment : TOnShowCommentEvent;
    FOnShowTiming : TOnShowTimingEvent;
    FOnDisplayMessage : TOnDisplayMessageEvent;