rar.pas

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

    fPackedSizeMVVolume:=hdrData.PackSize;
  if (fReadMVToEnd) and (((hdrData.Flags and $00000001)=$00000001)) and  //not last, not first part
    (((hdrData.Flags and $00000002)=$00000002)) then begin
    fPackedSizeMVVolume:=fPackedSizeMVVolume+hdrData.PackSize;
    exit;
  end;
  if (fReadMVToEnd) and (((hdrData.Flags and $00000001)=$00000001)) and  //last part
    (not ((hdrData.Flags and $00000002)=$00000002)) then
    hdrData.PackSize:=hdrData.PackSize+fPackedSizeMVVolume;

  if (fReadMVToEnd) and ((hdrData.Flags and $00000002)=$00000002) then //not last part
    exit;

  if fArchiveInformation.fArchiverMajorVersion*10+fArchiveInformation.fArchiverMinorVersion<hdrData.UnpVer then begin
    fArchiveInformation.fArchiverMinorVersion:=hdrData.UnpVer mod 10;
    fArchiveInformation.fArchiverMajorVersion:=(hdrData.UnpVer-fArchiveInformation.fArchiverMinorVersion) div 10;
  end;
  if ((hdrData.Flags and $00000004)=$00000004) then
    fArchiveInformation.fEncryption:=True;
  if ((hdrData.Flags and $00000010)=$00000010) then
    fArchiveInformation.fSolid:=True;
  OS:='unknown';
  case hdrData.HostOS of
    0: OS:='DOS';
    1: OS:='IBM OS/2';
    2: OS:='Windows';
    3: OS:='Unix';
  end;
  fArchiveInformation.fHostOS:=OS;
  if (not ((hdrData.Flags and $00000070)=$00000070)) and (hdrData.FileAttr<>faDirectory) then begin//not a directory
    fArchiveInformation.fTotalFiles:=fArchiveInformation.fTotalFiles+1;
    case (hdrData.Flags shl 24 shr 29) of
      0: fArchiveInformation.fDictionarySize:=65536;
      1: fArchiveInformation.fDictionarySize:=131072;
      2: fArchiveInformation.fDictionarySize:=262144;
      3: fArchiveInformation.fDictionarySize:=524288;
      4: fArchiveInformation.fDictionarySize:=1048576;
      5: fArchiveInformation.fDictionarySize:=2097152;
      6: fArchiveInformation.fDictionarySize:=4194304;
    end;
  end;
  fArchiveInformation.fCompressedSize:=fArchiveInformation.fCompressedSize+hdrData.PackSize;
  fArchiveInformation.fUnCompressedSize:=fArchiveInformation.fUnCompressedSize+hdrData.UnpSize;
  if ((hdrData.Flags and $00000001)=$00000001) or ((hdrData.Flags and $00000002)=$00000002) then    //file continued in last or next part
    fArchiveInformation.fMultiVolume:=True;
  if hdrData.CmtSize>0 then
    fArchiveInformation.fFileComment:=True;
  
  with FileItem do begin
    FileName:=StrPas(hdrData.FileName);
    FileNameW:=hdrData.FileNameW;
    CompressedSize:=hdrData.PackSize;
    UnCompressedSize:=hdrData.UnpSize;
    HostOS:=OS;
    CRC32:=Format('%x',[hdrData.FileCRC]);
    Attributes:=hdrData.FileAttr;
    Comment:=hdrData.CmtBuf;
    DosDateTimeToFileTime(HiWord(hdrData.FileTime),
      LoWord(hdrData.FileTime),
      ft);
    FileTimeToSystemTime(ft,st);
    Time:=SystemTimeToDateTime(st);
    CompressionStrength:=hdrData.Method;
    ArchiverVersion:=hdrData.UnpVer;
    Encrypted:=((hdrData.Flags and $00000004)=$00000004);
  end;
  if assigned(fOnListFile) then
    fOnListFile(Self,FileItem);
end;

procedure TRARArchiveInformation.Reset;
begin
  fOpened:=False;

  fFileName:='';
  fTotalFiles:=0;
  fArchiverMajorVersion:=0;
  fArchiverMinorVersion:=0;
  fDictionarySize:=0;
  fEncryption:=False;
  fSolid:=False;
  fHostOS:='';
  fTotalFiles:=0;
  fCompressedSize:=0;
  fUnCompressedSize:=0;
  fHeaderEncrypted:=False;
  fMultiVolume:=False;
  fArchiveComment:=False;
  fFileComment:=False;
  fComment:='';
  fLocked:=False;
  fSigned:=False;
  fRecovery:=False;
  fSFX:=False;
end;

function TRAR.List:boolean;
var
  ReadFileHeaderResult: integer;
begin
  assert(FileExists(fArchiveInformation.FileName));
  fAbort:=False;
  Result:=InitArchive(False);
  if fAbort or (not Result) then exit;
  try
    mySelf:=Self;
    RARSetCallback(Archivehandle,UnRarCallBack,Integer(mySelf));
    if Password<>'' then
      RARSetPassword(ArchiveHandle,PAnsiChar(Password));
    readFileHeaderResult:=RAR_SUCCESS;
    while (ReadFileHeaderResult=RAR_SUCCESS) and Result do begin
      ReadFileHeaderResult:=RARReadHeaderEx(ArchiveHandle,@hdrData);
      //ReadFileHeaderResult:=RARReadHeader(ArchiveHandle,@hdrData);

      if ReadFileHeaderResult=ERAR_END_ARCHIVE then
        break;
      if ReadFileHeaderResult<>RAR_SUCCESS then
        Result:=False;
      Error(ReadFileHeaderResult,roListFiles);

      ProgressHeader; //fOnListFile + writte data to farchiveInformation
      ReadFileHeaderResult:=RARProcessFile(ArchiveHandle,RAR_SKIP,NIL,NIL);

      if ReadFileHeaderResult<>RAR_SUCCESS then
        Result:=False;
      Error(ReadFileHeaderResult,roListFiles);
    end;
  finally
    CloseArchive;
  end;
end;

function extractFile(FileName:String;Files:TStrings):boolean;   //returns if the actual file should be extracted or not
var
  i:integer;
begin
  if Files=NIL then
    Result:=True
  else
    begin
      Result:=False;
      for i := 0 to Files.Count - 1 do          //check if actual file is in the filelist
        if UpperCase(Files[i])=UpperCase(FileName) then begin
          Result:=True;
          break;
        end;
    end;
end;

function TRAR.Extract(Path:AnsiString;RestoreFolder:boolean;Files:TStrings):boolean;
var
  ReadFileHeaderResult: integer;
  ExistentFile,ArchiveFile:TRARReplaceData;
  ft: _FILETIME;
  st: TSystemTime;
  ReplaceResult: TRARReplace;
begin
  assert(FileExists(fArchiveInformation.FileName));
  fAbort:=False;
  Result:=InitArchive(True);
  if fAbort or not (Result) then
    exit;
  if Path[Length(Path)]<>'\' then
    Path:=Path+'\';
  try
    mySelf:=Self;
    RARSetCallback(Archivehandle,UnRarCallBack,Integer(mySelf));
    if Password<>'' then
      RARSetPassword(ArchiveHandle,PAnsiChar(Password));
    readFileHeaderResult:=RAR_SUCCESS;
    fProgressInfo.TotalSize:=0;
    while (ReadFileHeaderResult=RAR_SUCCESS) and Result do begin
      ReadFileHeaderResult:=RARReadHeaderEx(ArchiveHandle,@hdrData);
      //ReadFileHeaderResult:=RARReadHeader(ArchiveHandle,@hdrData);

      if ReadFileHeaderResult=ERAR_END_ARCHIVE then
        Break;

      if ReadFileHeaderResult<>RAR_SUCCESS then begin
        Result:=False;
        Error(ReadFileHeaderResult,roListFiles);
      end;

      fProgressInfo.FileBytesDone:=0;
      fProgressinfo.FileBytesTotal:=hdrData.UnpSize;
      fProgressInfo.FileName:=hdrData.FileNameW;
      ReplaceResult:=rrOverWrite;

      if extractFile(StrPas(hdrData.FileName),Files) then begin    //todo: UniCode FileName

        if RestoreFolder then
          ExistentFile.FileName:=Path+StrPas(hdrData.FileName)
        else
          ExistentFile.FileName:=Path+ExtractFileName(StrPas(hdrData.FileName));
        ExistentFile.Size:=GetFileSize(ExistentFile.FileName);
        ExistentFile.Time:=GetFileModifyDate(ExistentFile.FileName);
        if RestoreFolder then
          ArchiveFile.FileName:=StrPas(hdrData.FileName)
        else
          ArchiveFile.FileName:=ExtractFileName(StrPas(hdrData.FileName));
        ArchiveFile.Size:=hdrData.UnpSize;
        DosDateTimeToFileTime(HiWord(hdrData.FileTime),
        LoWord(hdrData.FileTime),
        ft);
        FileTimeToSystemTime(ft,st);
        ArchiveFile.Time:=SystemTimeToDateTime(st);

        if FileExists(ExistentFile.FileName) then
          if assigned(fOnReplace) then
            fOnReplace(Self,ExistentFile,ArchiveFile,ReplaceResult);

        case ReplaceResult of
          rrCancel: fAbort:=True;
          rrOverwrite: if RestoreFolder then
                        ReadFileHeaderResult:=RARProcessFile(ArchiveHandle, RAR_EXTRACT, PAnsiChar(Path), NIL)
                      else
                        if (not ((hdrData.Flags and $00000070)=$00000070)) and (hdrData.FileAttr<>faDirectory) then
                          ReadFileHeaderResult:=RARProcessFile(ArchiveHandle, RAR_EXTRACT, Nil, PAnsiChar(ExistentFile.FileName));
          rrSkip: begin
                    ReadFileHeaderResult:=RARProcessFile(ArchiveHandle, RAR_SKIP, PAnsiChar(Path), NIL);
                    {$WARN COMBINING_SIGNED_UNSIGNED OFF}
                    fProgressInfo.FileBytesDone:=fProgressInfo.FileBytesDone+hdrData.UnpSize;
                    {$WARN COMBINING_SIGNED_UNSIGNED ON}
                  end;
        end;

      end else
        ReadFileHeaderResult:=RARProcessFile(ArchiveHandle, RAR_SKIP, NIL, NIL); //select next file without extracting

      if ReadFileHeaderResult<>RAR_SUCCESS then begin
        Result:=False;
        Error(ReadFileHeaderResult,roListFiles);
      end;

      if fAbort then
        Result:=False;
    end;
  finally
    CloseArchive;
  end;
  if fAbort then
    Result:=False;
end;

function TRAR.Test:boolean;
var
  ReadFileHeaderResult: integer;
begin
  assert(FileExists(fArchiveInformation.FileName));
  fAbort:=False;
  Result:=InitArchive(True);
  if fAbort or (not Result) then exit;
  try
    mySelf:=Self;
    RARSetCallback(Archivehandle,UnRarCallBack,Integer(mySelf));
    if Password<>'' then
      RARSetPassword(ArchiveHandle,PAnsiChar(Password));
    fProgressInfo.TotalSize:=0;
    readFileHeaderResult:=RAR_SUCCESS;
    while (ReadFileHeaderResult=RAR_SUCCESS) and Result do begin
      ReadFileHeaderResult:=RARReadHeaderEx(ArchiveHandle,@hdrData);
      //ReadFileHeaderResult:=RARReadHeader(ArchiveHandle,@hdrData);

      if ReadFileHeaderResult=ERAR_END_ARCHIVE then
        break;

      if ReadFileHeaderResult<>RAR_SUCCESS then begin
        Result:=False;
        Error(ReadFileHeaderResult,roListFiles);
      end;

      fProgressInfo.FileBytesDone:=0;
      fProgressinfo.FileBytesTotal:=hdrData.UnpSize;
      fProgressInfo.FileName:=hdrData.FileNameW;

      ReadFileHeaderResult:=RARProcessFile(ArchiveHandle,RAR_TEST,NIL,NIL);

      if ReadFileHeaderResult<>RAR_SUCCESS then begin
        Result:=False;
        Error(ReadFileHeaderResult,roListFiles);
      end;

      if fAbort then
        Result:=False;
    end;
  finally
    CloseArchive;
  end;
end;

procedure TRAR.LoadDLL;
begin
  RARDLLInstance:=LoadLibraryA(PAnsiChar(fDLLName));
  if RARDLLInstance<>0 then begin
    DllLoaded:=True;
    @RAROpenArchive:=GetProcAddress(RARDLLInstance,'RAROpenArchive');
    @RAROpenArchiveEx:=GetProcAddress(RARDLLInstance,'RAROpenArchiveEx');
    @RARCloseArchive:=GetProcAddress(RARDLLInstance,'RARCloseArchive');
    @RARReadHeader:=GetProcAddress(RARDLLInstance,'RARReadHeader');
    @RARReadHeaderEx:=GetProcAddress(RARDLLInstance,'RARReadHeaderEx');
    @RARProcessFile:=GetProcAddress(RARDLLInstance,'RARProcessFile');
    @RARSetCallback:=GetProcAddress(RARDLLInstance,'RARSetCallback');
    @RARSetChangeVolProc:=GetProcAddress(RARDLLInstance,'RARSetChangeVolProc');
    @RARSetProcessDataProc:=GetProcAddress(RARDLLInstance,'RARSetProcessDataProc');
    @RARSetPassword:=GetProcAddress(RARDLLInstance,'RARSetPassword');
    @RARGetDllVersion:=GetProcAddress(RARDLLInstance,'RARGetDllVersion');
    if (@RAROpenArchive=nil) or (@RAROpenArchiveEx=nil) or (@RARCloseArchive=nil)
    or (@RARReadHeader=nil) or (@RARReadHeaderEx=nil) or (@RARProcessFile=nil)
    or (@RARSetCallback=nil) or (@RARSetChangeVolProc=nil) or (@RARSetProcessDataProc=nil)
    or (@RARSetPassword=nil) or (@RARGetDllVersion=nil) then begin
      RARDLLInstance:=0;
      UnloadDLL;
    end;
    if RARGetDllVersion<MIN_RAR_VERSION then
      MessageBox(0,'please download the newest "unrar.dll" file. See www.rarlab.com','Error', MB_OK or MB_ICONERROR or MB_TASKMODAL);
  end
  else
    MessageBox(0, 'File "unrar.dll" not found', 'Error', MB_OK or MB_ICONERROR or MB_TASKMODAL);
end;

procedure TRAR.UnloadDLL;
begin
  if DllLoaded then begin
    FreeLibrary(RARDLLInstance);
    RARDLLInstance:=0;
  end;
end;

function TRAR.isDLLLoaded:boolean;
begin
  Result:=RARDLLInstance<>0;
end;

function TRAR.GetDllVersion:integer;
begin
  if not isDLLLoaded then
    LoadDLL;
  if not isDLLLoaded then begin
    Error(ERAR_DLL_LOAD_ERROR,roInitArchive);
    Result:=0;
    Exit;
  end;
  Result:=RARGetDllVersion;
end;

procedure TRAR.Abort;
begin
  fAbort:=True;
end;

procedure TRAR.Error(ErrorCode:integer;Operation:TRAROperation);
begin
  if (ErrorCode=ERAR_DLL_LOAD_ERROR) or
     //(ErrorCode=ERAR_END_ARCHIVE) or
     (ErrorCode=ERAR_NO_MEMORY) or
     (ErrorCode=ERAR_BAD_DATA) or
     (ErrorCode=ERAR_UNKNOWN_FORMAT) or
     (ErrorCode=ERAR_EOPEN) or
     (ErrorCode=ERAR_ECREATE) or
     (ErrorCode=ERAR_ECLOSE) or
     (ErrorCode=ERAR_EREAD) or
     (ErrorCode=ERAR_EWRITE) or
     (ErrorCode=ERAR_SMALL_BUF) or
     (ErrorCode=ERAR_UNKNOWN) then
    fAbort:=True;

  if assigned(fOnError) then
    fOnError(Self,ErrorCode,Operation);
end;

function TRAR.getVersion:String;
begin
  result:=fVersion;
end;

end.