vclunzip.pas

一个delphi中压缩的组件VCLZip

      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetUnCompressedSize(Index: Integer): LongInt;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.uncompressed_size;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetExternalFileAttributes(Index: Integer): U_LONG;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.external_file_attributes;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetIsEncrypted(Index: Integer): Boolean;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.Encrypted;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetHasComment(Index: Integer): Boolean;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.HasComment;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetZipHasComment: Boolean;
begin
   Result := ecrec.zip_comment_length > 0;
end;

function TVCLUnZip.GetFileComment(Index: Integer): string;
var
   finfo                 : TZipHeaderInfo;
   crec                  : central_file_header;
   CommentLength         : LongInt;
   RememberModified      : Boolean;
   RememberPosition      : LongInt;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      with finfo do
      begin
         if HasComment then
         begin
            RememberPosition := 0;
            if finfo.filecomment = nil then
            try
               OpenZip;
               RememberPosition := theZipFile.Position;
               theZipFile.Seek(central_offset, soFromBeginning);
               theZipFile.Read(crec, SizeOf(central_file_header));
               with crec do
               begin
                  theZipFile.Seek(filename_length + extra_field_length, soFromCurrent);
                  {$IFDEF WIN32}
                  CommentLength := file_comment_length;
                  {$ELSE}
                  CommentLength := kpmin(file_comment_length, 255);
                  {$ENDIF}
                  SetLength(Result, CommentLength);
                  theZipFile.Read(Result[1], CommentLength);
                  RememberModified := ecrec.Modified;
                  SetFileComment(Index, Result);        { Save it in central header }
                  ecrec.Modified := RememberModified;
               end;
            finally
               theZipFile.Seek(RememberPosition, soFromBeginning);
               If (MultiMode = mmNone) then
                 CloseZip;
            end
            else
               Result := StrPas(finfo.filecomment);
         end
         else
            Result := '';                               { No comment }
      end;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

procedure TVCLUnZip.ResetFileIsOK(Index: Integer);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      finfo.FileIsOK := icUNDEFINED;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.CheckArchive: Boolean;
var
   tmpDoAll              : Boolean;
begin
   tmpDoAll := DoAll;
   DoAll := True;
   Result := ProcessIntegrityCheck(-1);
   DoAll := tmpDoAll;
end;

function TVCLUnZip.GetFileIsOK(Index: Integer): Boolean;
var
   tmpDoAll              : Boolean;
begin
   tmpDoAll := DoAll;
   DoAll := False;
   Result := ProcessIntegrityCheck(Index);
   DoAll := tmpDoAll;
end;

function TVCLUnZip.ProcessIntegrityCheck(Index: Integer): Boolean;
var
   n, r                  : Integer;
   s                     : PChar;
   saveRecreateDirs      : Boolean;
   saveDestDir           : string;
   finfo                 : TZipHeaderInfo;
begin
   r := icUNDEFINED;
   finfo := nil;
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      r := finfo.FileIsOK;
   end
   else
      if (Index <> -1) then
         {$IFDEF NO_RES}
         raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
         raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}

   if (Index <> -1) and (r = icFILEOK) then
      Result := True
   else
      if (Index <> -1) and (r = icFILEBAD) then
         Result := False
      else                                              { r = icUNDEFINED }
      begin
         FTestMode := True;
         saveRecreateDirs := RecreateDirs;
         saveDestDir := DestDir;
         Result := False;
         if (Index <> -1) then
            finfo.FileIsOK := icFILEBAD;
         try
            RecreateDirs := True;
            DestDir := ''; { changed from 'c:\TestZip\' 2/14/99 2.17+ }
            s := PChar(1);                              { Just to be sure it's not nil }
            n := UnzipToBufferByIndex(s, Index);        { Dummy Buffer }
            if (n > 0) then
            begin
               Result := True;
               if (Index <> -1) then
                  finfo.FileIsOK := icFILEOK
               else
               begin
                  if DoAll then
                  begin
                     if (n < Count) then
                        Result := False;
                  end
                  else
                     if (n <> FNumSelected) then
                        Result := False;
               end;
            end;
         finally
            FTestMode := False;
            RecreateDirs := saveRecreateDirs;
            DestDir := saveDestDir;
         end;
      end;
end;

function TVCLUnZip.GetZipComment: string;
var
   CommentLength         : LongInt;
   RememberModified      : Boolean;
   RememberPosition      : LongInt;
begin
   if ecrec.zip_comment_length = 0 then
      Result := ''
   else
      with ecrec do
      begin
         if ecrec.ZipComment = nil then
         begin
           OpenZip;
           RememberPosition := theZipFile.Position;
            try
               theZipFile.Seek(ZipCommentPos, soFromBeginning);
               {$IFDEF WIN32}
               CommentLength := zip_comment_length;
               {$ELSE}
               CommentLength := kpmin(zip_comment_length, 255);
               {$ENDIF}
               SetLength(Result, CommentLength);
               theZipFile.Read(Result[1], CommentLength);
               RememberModified := Modified;
               SetZipComment(Result);                   { Save it in ecrec }
               Modified := RememberModified;
            finally
               theZipFile.Seek(RememberPosition, soFromBeginning);
               If (MultiMode = mmNone) then
                 CloseZip;
            end;
         end
         else
            Result := PCharToStr(ecrec.ZipComment);
      end;
end;

procedure TVCLUnZip.SetZipComment(theComment: string);
begin
   if ((ecrec.ZipComment = nil) and (theComment <> '')) or
      (StrComp(ecrec.ZipComment, StringAsPChar(theComment)) <> 0) then
   begin
      ecrec.SetNewZipComment(theComment);
      ecrec.Modified := True;
   end;
end;

procedure TVCLUnZip.SetFileComment(Index: Integer; theComment: string);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      if ((finfo.filecomment = nil) and (theComment <> '')) or
         (StrComp(finfo.filecomment, StringAsPChar(theComment)) <> 0) then
      begin
         if finfo.filecomment <> nil then
            finfo.filecomment := nil;
         if theComment = '' then
            finfo.filecomment := nil
         else
         begin
            { Changed StrToPChar to StringAsPChar  7/16/98  2.14 }
            finfo.filecomment := StringAsPChar(theComment);
         end;
         ecrec.Modified := True;
      end;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

{ 3/10/98  2.03}
{ These are overriden in VCLZip }

function TVCLUnZip.GetMultiMode: TMultiMode;
begin
   Result := FMultiMode;
end;

{ 3/10/98  2.03}

procedure TVCLUnZip.SetMultiMode(Value: TMultiMode);
begin
   FMultiMode := Value;
end;

function TVCLUnZip.GetDiskNo(Index: Integer): Integer;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.disk_number_start + 1;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetSelected(Index: Integer): Boolean;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.Selected;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

procedure TVCLUnZip.SetSelected(Index: Integer; Value: Boolean);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      if (finfo.Selected <> Value) then
      begin
         finfo.Selected := Value;
         if (Value = True) then
            Inc(FNumSelected)
         else
            Dec(FNumSelected);
      end;
   end
   else
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

procedure TVCLUnZip.GetDecryptHeaderPtr(Index: Integer; dhPtr: BytePtr);