rar.pas

支持版本:Delphi 5-2009, C++Builder 5-2009 ATViewer特性： Text, Binary, Hex, Unicode：所有文件

//  written by Philippe Wechsler 2008
//
//  web: www.PhilippeWechsler.ch
//  mail: [e-mail]
//
//  please see license.txt and documentation.txt
//
//  changes in 1.2 stable
//   - support for delphi 2009
//   - support for unicode filenames (see TRARFileItem.FileNameW)
//   - dll name + path is custom
//   - fixed a memory leak (thanks to Claes Ensk鋜)
//   - some small improvements in the demo
//  changes in 1.1 stable
//   - fixed problem with mySelf pointer - you can use now multiple TRAR instances
//   - "SFX" in archive informations
//   - code better commented
//   - bugfixing in reading multivolumes
//
//  known bugs:
//   - when extracting files that contains unicode characters there's no test if
//     the file exists allready
//   - open archives that contains unicode characters in the archive name fails

unit RAR;

interface

uses
  Classes, SysUtils,Windows,RAR_DLL;

type
  TRAROperation=(roInitArchive, roListFiles, roExtract, roTest);

type
  TRARProgressInfo = record
    FileBytesDone:LongInt;
    FileBytesTotal:LongInt;
    FileName:WideString;
    TotalSize:LongInt;
  end;

type
  TRARFileItem = record
    FileName:AnsiString;
    FileNameW:WideString;
    CompressedSize:cardinal;
    UnCompressedSize:cardinal;
    HostOS:String;
    CRC32:String;
    Attributes:Cardinal;
    Comment:AnsiString;
    Time:tDateTime;
    CompressionStrength:cardinal;
    ArchiverVersion:cardinal;
    Encrypted:boolean;
  end;

type TRARReplaceData=record
  FileName:AnsiString;
  Size:int64;
  Time:tDateTime;
end;

TRARReplace=(rrCancel, rrOverwrite, rrSkip);

type
  TOnRARErrorNotifyEvent = procedure(Sender: TObject; const ErrorCode:integer; const Operation: TRAROperation) of object;
  TOnRARListFile = procedure(Sender: TObject; const FileInformation:TRARFileItem) of Object;
  TOnRARPasswordRequired = procedure(Sender: TObject; const HeaderPassword:boolean; const FileName:AnsiString;out NewPassword:AnsiString; out Cancel:boolean) of object;
  TOnRARNextVolumeRequired = procedure(Sender: TObject;const requiredFileName:AnsiString; out newFileName:AnsiString ;out Cancel:boolean) of Object;
  TOnRARProcess = procedure(Sender: TObject; const FileName:WideString; const ArchiveBytesTotal, ArchiveBytesDone, FileBytesTotal, FileBytesDone:cardinal) of Object;
  TOnRARReplace = procedure(Sender: TObject; const ExistingData,NewData:TRARReplaceData;out Action:TRARReplace) of object;

type
  TRARArchiveInformation = class (TPersistent)
  private
    fOpened:boolean;
    fFileName:AnsiString;
    fArchiverMajorVersion:Cardinal;
    fArchiverMinorVersion:Cardinal;
    fDictionarySize:int64;
    fEncryption:boolean;
    fSolid:boolean;
    fHostOS:String;
    fTotalFiles:integer;
    fCompressedSize:int64;
    fUnCompressedSize:int64;
    fHeaderEncrypted:boolean;
    fMultiVolume:boolean;
    fArchiveComment:boolean;
    fFileComment:boolean;
    fComment:AnsiString;
    fSigned:boolean;
    fLocked:boolean;
    fRecovery:boolean;
    fSFX:boolean;
    procedure Reset;
  protected
  public
  published
    property FileName: AnsiString read fFileName;
    property ArchiverMajorVersion: cardinal read fArchiverMajorVersion;
    property ArchiverMinorVersion: cardinal read fArchiverMinorVersion;
    property DictionarySize: int64 read fDictionarySize;
    property Encryption: boolean read fEncryption;
    property Solid: boolean read fSolid;
    property HostOS: String read fHostOS;
    property TotalFiles: integer read fTotalFiles;
    property CompressedSize: int64 read fCompressedSize;
    property UnCompressedSize: int64 read fUnCompressedSize;
    property HeaderEncrypted: boolean read fHeaderEncrypted;
    property MultiVolume: boolean read fMultiVolume;
    property ArchiveComment: boolean read fArchiveComment;
    property FileComment: boolean read fFileComment;
    property Comment: AnsiString read fComment;
    property Signed: boolean read fSigned;
    property Locked: boolean read fLocked;
    property Recovery: boolean read fRecovery;
    property SFX: boolean read fSFX;
  end;

type
  TRAR = class(TComponent)
  private
    RARDLLInstance:THandle;
    fAbort:Boolean;
    fProgressInfo:TRARProgressInfo;
    fReadMVToEnd:boolean;
    fPackedSizeMVVolume:Cardinal;
    Password:AnsiString;
    Comment:PAnsiChar;
    CommentResult:Cardinal;
    fArchiveInformation:TRARArchiveInformation;
    ArchiveData:TRARArchiveDataEx;
    ArchiveHandle:Cardinal;
    hdrData:TRARHeaderDataEx; 
    //hdrData:TRARHeaderData;
    fDLLName:AnsiString;
    fOnError:TOnRARErrorNotifyEvent;
    fOnListFile:TOnRARListFile;
    fOnPasswordRequired:TOnRARPasswordRequired;
    fOnNextVolumeRequired:TOnRARNextVolumeRequired;
    fOnProcess:TOnRARProcess;
    fOnReplace:TOnRARReplace;
    MySelf: Pointer;
    function InitArchive(Extract:boolean):boolean;
    function CloseArchive:boolean;
    function OnUnRarCallBack(msg:Cardinal; UserData, P1, P2:LongInt):integer; stdcall;
    procedure ProgressHeader;
    procedure Error(ErrorCode:integer;Operation:TRAROperation);
    function getVersion:String;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function OpenFile(FileName:String):boolean;
    function List:boolean;
    function Extract(Path:AnsiString;RestoreFolder:Boolean;Files:TStrings):boolean;
    function Test:boolean;
    procedure Abort;
    procedure LoadDLL;
    procedure UnloadDLL;
    function isDLLLoaded:boolean;
    function GetDllVersion:integer;
  published
    property Version: String read getVersion;
    property ReadMultiVolumeToEnd:boolean read fReadMVToEnd write fReadMVToEnd; //if true, mv's will be read until last part of the file
    //pro:display correct crc + display all files in all parts
    //contra: all volumes required=to open you have to insert all disk if not all volumes in sam folder
    property DllName: AnsiString read fDLLName write fDLLName;
    property OnError: TOnRARErrorNotifyEvent read fOnError write fOnError;
    property OnListFile: TOnRARListFile read fOnListFile write fOnListFile;
    property OnPasswordRequired: TOnRARPasswordRequired read fOnPasswordRequired write fOnPasswordRequired;
    property OnNextVolumeRequired:TOnRARNextVolumeRequired read fOnNextVolumeRequired write fOnNextVolumeRequired;
    property OnProgress: TOnRARProcess read fOnProcess write fOnProcess;
    property OnReplace: TOnRARReplace read fOnReplace write fOnReplace;
    property ArchiveInformation:TRARArchiveInformation read fArchiveInformation;
  end;

procedure Register;

implementation

const
  fVersion='1.2';

procedure Register;
begin
  RegisterComponents('Philippe Wechsler', [TRAR]);
end;

function UnRarCallBack(msg:Cardinal; UserData, P1, P2:LongInt):integer; stdcall;
begin
  //Result:=TRAR(mySelf).OnUnRarCallBack(msg, UserData, P1, P2);
  Result:=TRAR(UserData).OnUnRarCallBack(msg, UserData, P1, P2);
end;

function TRAR.OnUnRarCallBack(msg:Cardinal; UserData, P1, P2:LongInt):integer; stdcall;
var
  Password, FileName, PasswordFile:AnsiString;
  Cancel:Boolean;
begin
  Password:='';
  Cancel:=False;
  Result:=0;
  case msg of
    UCM_CHANGEVOLUME: begin
                        FileName:=PAnsiChar(P1);
                        case P2 of
                          RAR_VOL_ASK:    begin
                                            if (not fArchiveInformation.fOpened) and (not fReadMVToEnd) then begin
                                              Result:=-1
                                            end else begin
                                              if assigned(fOnNextVolumeRequired) then
                                                fOnNextVolumeRequired(Self,PAnsiChar(P1),FileName,Cancel);
                                              StrPCopy(PAnsiChar(P1),FileName); //todo: handle error if P1 has not enough space for FileName
                                              if fAbort or Cancel then
                                                Result:=-1
                                              else
                                                Result:=0;
                                            end;
                                          end;
                          RAR_VOL_NOTIFY: begin        //occurs when next volume required and next part was found
                                            Result:=0; //continue
                                          end;
                        end;

                      end;
    UCM_NEEDPASSWORD: begin
                        if not fArchiveInformation.fOpened then begin
                          fArchiveInformation.fHeaderEncrypted:=True;
                          PasswordFile:=fArchiveInformation.FileName;
                        end else
                          PasswordFile:=fProgressInfo.FileName;
                        if assigned(fOnPasswordRequired) then
                          fOnPasswordRequired(Self,not fArchiveInformation.fOpened,PasswordFile,Password,Cancel);
                        StrPCopy(Pointer(P1), Copy(Password, 1, P2));
                        if fAbort or Cancel then
                          Result := -1
                        else
                          Result := 0;
                      end;
    UCM_PROCESSDATA:  begin
                        fProgressInfo.FileBytesDone:=fProgressInfo.FileBytesDone+P2;
                        fProgressInfo.TotalSize:=fProgressInfo.TotalSize+P2;
                        if assigned(fOnProcess) then
                          fOnProcess(Self,fProgressInfo.FileName,
                          fArchiveInformation.UnCompressedSize, fProgressInfo.TotalSize,
                          fProgressInfo.FileBytesTotal,fProgressInfo.FileBytesDone);
                        if fAbort then
                          Result := -1
                        else
                          Result := 0;
                      end;
  end;
  if fAbort then
    Result:=-1;
end;

constructor TRAR.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fArchiveInformation:=TRARArchiveInformation.Create;
  fReadMVToEnd:=False;
  mySelf:=Self;
  fDLLName:='unrar.dll';
end;

destructor TRAR.Destroy;
begin
  if Assigned(comment) then
    FreeMem(comment);
  FreeAndNil(fArchiveInformation);
  UnLoadDLL;
  inherited Destroy;
end;

function TRAR.OpenFile(FileName: string):boolean;
begin
  fArchiveInformation.Reset;
  if not isDLLLoaded then
    LoadDLL;
  if not isDLLLoaded then begin
    Error(ERAR_DLL_LOAD_ERROR,roInitArchive);
    Result:=False;
    Exit;
  end;
  fArchiveInformation.fFileName:=FileName;
  Result:=List;
  fArchiveInformation.fOpened:=True;
end;

function TRAR.InitArchive(Extract:boolean):boolean;
begin
  Result:=True;
  CommentResult:=RAR_SUCCESS;
  with ArchiveData do begin
    OpenResult:=RAR_SUCCESS;
    if Extract then
      OpenMode:=RAR_OM_EXTRACT
    else
      if fReadMVToEnd then
        OpenMode:=RAR_OM_LIST_INCSPLIT
      else
        OpenMode:=RAR_OM_LIST;
    ArcName:=PAnsiChar(fArchiveInformation.FileName);
    //ArcNameW:=PWideChar(fArchiveInformation.FileName);
    if not Assigned(Comment) then
      GetMem(Comment,MAX_RAR_COMMENTSIZE);
    CmtBuf:=Comment;
    CmtBufSize:=MAX_RAR_COMMENTSIZE;
    CmtSize:=length(Comment);
    CmtState:=CommentResult;
  end;
  ArchiveHandle:=RAROpenArchiveEx(@ArchiveData);
  //ArchiveHandle:=RAROpenArchive(@ArchiveData);
  if ArchiveHandle=0 then begin           //handle incorrect=failed to load dll
    Error(ERAR_DLL_LOAD_ERROR,roInitArchive);
    Result:=False;
    exit;
  end;
  //((ArchiveData.Flags and $00000100)=$00000100)=first volume
  //((ArchiveData.Flags and $00000001)=$00000001)=Volume attribute (archive volume)
  //((ArchiveData.Flags and $00000010)=$00000010)=New volume naming scheme ('volname.partN.rar')

  if ((ArchiveData.Flags and $00000004)=$00000004) then    //set archive info
    fArchiveInformation.fLocked:=True;
  if ((ArchiveData.Flags and $00000020)=$00000020) then
    fArchiveInformation.fSigned:=True;
  if ((ArchiveData.Flags and $00000040)=$00000040) then
    fArchiveInformation.fRecovery:=True;
  if ((ArchiveData.Flags and $00000008)=$00000008) then
    fArchiveInformation.fSolid:=True;
  if ((ArchiveData.Flags and $00000002)=$00000002) then
    fArchiveInformation.fArchiveComment:=True;
  if ((ArchiveData.Flags and $00000080)=$00000080) then
    fArchiveInformation.fHeaderEncrypted:=True;
  fArchiveInformation.fSFX:=isSFX(fArchiveInformation.FileName);

  case ArchiveData.CmtState of                              //read archive comment
    ERAR_COMMENTS_EXISTS: begin
                            fArchiveInformation.fComment:=StrPas(Comment);
                            fArchiveInformation.fArchiveComment:=True;
                          end;
    ERAR_NO_COMMENTS:     begin
                            fArchiveInformation.fComment:='';
                            fArchiveInformation.fArchiveComment:=False;
                          end;
    ERAR_NO_MEMORY:       Error(ERAR_NO_MEMORY,roInitArchive);
    ERAR_BAD_DATA:        Error(ERAR_BAD_DATA,roInitArchive);
    ERAR_UNKNOWN_FORMAT:  Error(ERAR_UNKNOWN_FORMAT,roInitArchive);
    ERAR_SMALL_BUF:       Error(ERAR_SMALL_BUF,roInitArchive);
  end;
  if (ArchiveData.CmtState<>ERAR_NO_COMMENTS) and (ArchiveData.CmtState<>ERAR_COMMENTS_EXISTS) then
    result:=False;      //error reading comment
end;

function TRAR.CloseArchive:boolean;
var
  CloseResult:integer;
begin
  CloseResult:=RARCloseArchive(ArchiveHandle);
  if CloseResult=ERAR_ECLOSE then
    Error(ERAR_ECLOSE,roInitArchive);
  Result:=(CloseResult=RAR_SUCCESS);
end;

procedure TRAR.ProgressHeader;     //write data to archiv information and  list file
var
  FileItem:TRARFileItem;
  ft: _FILETIME;
  st: TSystemTime;
  OS:String;
begin
  if (fReadMVToEnd) and (not ((hdrData.Flags and $00000001)=$00000001)) and  //first part of the file
    (((hdrData.Flags and $00000002)=$00000002)) then