kpunzipp.pas

一个delphi中压缩的组件VCLZip

finally
  If (not StreamZipping) and (not MemZipping) then
   begin
     zip_out_file.Free;
     zip_out_file := nil;
     If (FinishedOK) then
      begin
        FileHandle := FileOpen(zip_out_file_name, fmOpenWrite or fmShareDenyNone);
        FileSetDate(FileHandle, GoodTimeStamp(file_info.last_mod_file_date_time));
        FileClose(FileHandle);
        { Moved the following from before setting date because if read-only setting
          the date was not possible }     { 1/18/00 2.20+ }
        If RetainAttributes then
           FileSetAttr( zip_out_file_name, file_info.external_file_attributes );
      end;
   end;
  If (MemZipping) and (not FinishedOK) then
   begin
     If (AllocatedBuffer) then
        FreeMem(MemBuffer, file_info.uncompressed_size);
     MemBuffer := nil;
   end;
end;  { try }
  Crc32Val := not Crc32Val;
  If (Crc32Val <> file_info.crc32) then
   begin
     If (file_info.Encrypted) then  { bad password entered }
      begin
        If Assigned( FOnBadPassword ) then
         begin
           NewPassword := Password;
           FOnBadPassword( self, Index, NewPassword );
           If NewPassword <> Password then
            begin
              Password := NewPassword;
              RepeatFile := True;
            end;
         end;
        If (not RepeatFile) and Assigned( FOnSkippingFile ) then
           FOnSkippingFile( self, srBadPassword, file_info.directory+file_info.filename, Index, Retry );
      end
     Else If (Assigned( FOnBadCRC )) then
        FOnBadCRC( self, Crc32Val, file_info.crc32, Index );
     If (not StreamZipping) and (not MemZipping) then
        SysUtils.DeleteFile( zip_out_file_name );
     If (not RepeatFile) then
        Dec(FileCount);
   end
  Else
   begin
     If Assigned( FOnEndUnZip ) then
        FOnEndUnZip( self, Index, zip_out_file_name );
     Inc(NumUnZipped);
   end;
end;

{******************************************************************************************}
var
 i, j: Integer;
 finfo: TZipHeaderInfo;
 StopNow: Boolean;
 CompareFileName: String;
 SaveSortMode: TZipSortMode;
 SaveKeepZipOpen: Boolean;
 {FinishedOK: Boolean;}
begin
  {FinishedOK := False;}  { 5/18/98  2.13 }
  {Result := 0;}          { 5/18/98  2.13 }
 CancelOperation := False;
 SaveKeepZipOpen := FKeepZipOpen;
 FKeepZipOpen := True;
 Retry := False;
 New( area );
 slide := @(area^.slide);
 GetMem( inbuf, INBUFSIZ+1 );
 GetMem( outbuf, OUTBUFSIZ+1 );
 If DestDir <> '' then
  begin
     If not DirExists( FDestDir ) then
        ForceDirs(FDestDir);
  end;

 SaveSortMode := ByNone;
 If (ecrec.this_disk <> 0) and (FSortMode <> ByNone) then
  begin
     SaveSortMode := FSortMode;
     Sort(ByNone);
  end;
 inptr := inbuf;
 outptr := outbuf;
try
 TotalUncompressedSize := 0;
 TotalBytesDone := 0;
 FileCount := Count;
 { Determine which files will be extracted }
 For j := 0 to Count-1 do
   begin
     finfo := sortfiles.Items[j] as TZipHeaderInfo;
     finfo.MatchFlag := FDoAll;
     If (finfo.filename = '') and (not RecreateDirs) then  { it's just a dirname }
      begin
        finfo.MatchFlag := False;
        Dec(FileCount);
        continue;
      end;
     i := 0;
     If UnZippingSelected then
      begin
        If finfo.Selected then
         begin
           finfo.MatchFlag := True;
           finfo.Selected := False;
         end;
      end
     Else
      While (i < FFilesList.Count) do  { Compare with fileslist till we find a match }
       begin     { removed check for '\'  5/19/98  2.13 }
        CompareFileName := LowerCase(finfo.Directory + finfo.filename);
           If (IsMatch(LowerCase(FFilesList[i]), CompareFileName)) then
            begin
              finfo.MatchFlag := True;   { Found a match }
              Break;                     { So we can stop looking }
            end
           Else
              Inc(i);                    { Didn't find a match yet }
       end;
     { Removed check for filename <> '' 8/21/01  2.22+ }
     { Wasn't allowing dirs to be restored unless DoAll was set }
     If (finfo.MatchFlag) {and (finfo.filename <> '')} then           { If this file is to be extracted }
        TotalUncompressedSize := TotalUnCompressedSize +  finfo.uncompressed_size
     Else
        Dec(FileCount);                { otherwise one less file to extract }
   end;
 StopNow := False;
 If Assigned( FOnStartUnzipInfo ) then    { Give application a chance to stop it now }
   OnStartUnzipInfo( self, FileCount, TotalUncompressedSize, StopNow );
 NumUnZipped := 0;
 If (FileCount > 0) and (not StopNow) then                     { If not stopping then let's extract the files }
  begin
   If FDoAll then                       { If all files, then do them fast }
    For j := 0 to Count-1 do
         begin
           Repeat
              Do_Unzip( j )
           Until RepeatFile = False;
         end
   Else                                 { otherwise, check their flag first }
    begin
     For i := 0 to Count-1 do
      begin
        finfo := sortfiles.Items[i] as TZipHeaderInfo;
        If finfo.MatchFlag then
            Repeat
              Do_Unzip( i );
            Until RepeatFile = False;
      end;
    end;
  end;
  {FinishedOK := True;}  { 5/18/98  2.13 }
finally
  {If FinishedOK then}   { 5/18/98  2.13 }
     {Result := FileCount;}
  Result := NumUnZipped;
  Dispose( area );
  FreeMem( inbuf, INBUFSIZ+1 );
  FreeMem( outbuf, OUTBUFSIZ+1 );
  FilesList.Clear;  { 6/27/99 2.18+ }
  If (ecrec.this_disk <> 0) and (SaveSortMode <> ByNone) then
     Sort(SaveSortMode);
  if Assigned(FOnUnZipComplete) then FOnUnZipComplete(self, result);
  KeepZipOpen := SaveKeepZipOpen;
end; { try/finally }
end; { UnZipp }



{****************************************************************************}
{                            Encryption                                      }
{****************************************************************************}
procedure TVCLUnZip.update_keys( ch: char );
begin
  Key[0] := UpdCRC(BYTE(ch), Key[0]);
  Inc(Key[1], Key[0] and $ff);
  Key[1] := Key[1] * 134775813 + 1;
  Key[2] := UpdCRC( BYTE(WORD(Key[1] shr 24)), Key[2] );
end;

function TVCLUnZip.decrypt_byte: BYTE;
var
 temp: WORD;
begin
 temp := WORD(Key[2]) or 2;
  Result := BYTE(WORD(temp * (temp xor 1)) shr 8);
end;

procedure TVCLUnZip.decrypt_buff( bufptr: BYTEPTR; num_to_decrypt: LongInt );
var
 i: Integer;
begin
 for i := 0 to num_to_decrypt-1 do
   begin
    bufptr^ := bufptr^ xor decrypt_byte;
     update_keys(Char(bufptr^));
     Inc(bufptr);
   end;
end;

procedure TVCLUnZip.Init_Keys( Passwrd: String );
var
  i: Integer;
begin
  Key[0] := 305419896;
  Key[1] := 591751049;
  Key[2] := 878082192;

  For i := 1 to Length(Passwrd) do
   update_keys( Passwrd[i] );
end;

function TVCLUnZip.DecryptHeaderByte( Passwrd: String; dh: DecryptHeaderType ): BYTE;
var
  i: Integer;
  C: BYTE;
begin
  Init_Keys( Passwrd );

  For i := 0 to 11 do
   begin
     C := dh[i] xor decrypt_byte;
     update_keys( char(C) );
     dh[i] := C;
   end;
   Result := dh[11];
end;

function TVCLUnZip.DecryptHeaderByteByPtr( Passwrd: String; dh: BytePtr ): Byte;
var
  dhTemp: DecryptHeaderType;
  i: Integer;
begin
  For i := 0 to 11 do
   begin
     dhTemp[i] := dh^;
     Inc(dh);
   end;
  Result := DecryptHeaderByte( Passwrd, dhTemp );
end;

function TVCLUnZip.DecryptTheHeader( Passwrd: String; zfile: TStream ): BYTE;
var
  aDecryptHeader: DecryptHeaderType;
begin
   zfile.Read( aDecryptHeader, SizeOf(DecryptHeaderType) );
  {Cant't do the following to a property}
  {Dec(file_info.compressed_size, SizeOf(DecryptHeader));}
  file_info.compressed_size := file_info.compressed_size - SizeOf(DecryptHeaderType);

  Result := DecryptHeaderByte(Passwrd, aDecryptHeader);
end;

{****************************************************************************}
{                                   CRC                                      }
{****************************************************************************}
Function TVCLUnZip.UpdCRC(Octet: Byte; Crc: U_LONG) : U_LONG;
Var
   L : U_LONG;
   W : Array[1..4] of Byte Absolute L;
Begin
   Result := CRC_32_TAB[Byte(Crc XOR U_LONG(Octet))] XOR ((Crc SHR 8) AND $00FFFFFF);
end {UpdCRC};

procedure TVCLUnZip.Update_CRC_buff( bufptr: BYTEPTR; num_to_update: LongInt );
var
 i: Integer;
begin
 for i := 0 to num_to_update-1 do
   begin
     Crc32Val := UpdCRC( bufptr^, Crc32Val );
     Inc(bufptr);
   end;
end;

{ $Id: kpUnzipp.Pas,v 1.1 2001-08-12 17:30:39-04 kp Exp kp $ }

{ $Log: kpUnzipp.Pas,v $
{ Revision 1.1  2001-08-12 17:30:39-04  kp
{ Initial revision
{
{ Revision 1.30  2000-12-16 16:50:10-05  kp
{ 2.21 Final Release 12/12/00
{
{ Revision 1.29  2000-06-04 15:56:43-04  kp
{ - Fixed problem where directories couldn't be created from directory entries because the
{   fullpath wasn't known yet.  Result of having moved this code to earlier.
{
{ Revision 1.28  2000-05-21 18:46:08-04  kp
{ - Raised num_to_decrypt parameter of decrypt_buff to a LongInt from a WORD to handle longer buffers.
{ - Same as above for Update_CRC_buff
{
{ Revision 1.27  2000-05-13 16:28:07-04  kp
{ - Changed code to better handle unzipping directory entries
{ - Added code for BufferedStreamSize property
{
{ Revision 1.26  1999-11-03 17:38:47-05  kp
{ - removed unnecessary line of code (call to LoadStr) which caused a compiler error
{   when compiling with NO_RES defined.
{ - Added ifdefs around tmpMStr2 which cause compiler error when NO_RES was defined.
{
{ Revision 1.25  1999-10-24 12:13:04-04  kp
{ - Added to keep zip open during unzip operation.
{
{ Revision 1.24  1999-10-20 18:14:53-04  kp
{ - Modified calls to OnSkippingFile to add Retry parameter
{
{ Revision 1.23  1999-10-17 12:01:11-04  kp
{ - Changed min and max to kpmin and kpmax
{
{ Revision 1.22  1999-10-11 20:11:39-04  kp
{ - Added FlushFilesOnClose property
{
{ Revision 1.21  1999-09-14 21:29:30-04  kp
{ - Removed erroneous CurrentDisk := 0
{
{ Revision 1.20  1999-08-25 17:56:58-04  kp
{ - Fixed problem for PRP, resetting inptr and outptr for each file.
{ - DecryptHeader methods for BCB
{
{ Revision 1.19  1999-07-05 11:25:42-04  kp
{ - Modified so FilesList is cleared when unzip operation is done.
{
{ Revision 1.18  1999-06-27 13:58:21-04  kp
{ - Modified so directory entries will cause the directory to be created if not there and
{   RecreateDirs is True
{ - Added code to handle UnZipping Selected files
{ - Added code for DecryptHeader property
{
{ Revision 1.17  1999-04-24 21:13:57-04  kp
{ - Mod for setting zip file pointer if file encrypted
{
{ Revision 1.16  1999-04-10 10:16:15-04  kp
{ - Modified counter for keeping track of how many files unzipped.
{ - Added seek in zip file just before unzipping, just incase filepointer has changed
{ - Added OnUnZipComplete event call
{
{ Revision 1.15  1999-03-30 19:43:23-05  kp
{ - Modified so that defining MAKESMALL will create a much smaller component.
{
{ Revision 1.14  1999-03-25 17:04:39-05  kp
{ - Added additional try...except blocks, mainly for PRP, but also alows for calling
{   huft_free when an exception occurs.
{
{ Revision 1.13  1999-03-23 17:41:48-05  kp
{ - moved comments to bottom
{ - modified huft_build for better error checking
{
{ Revision 1.12  1999-03-22 17:33:59-05  kp
{ - added GoodTime check when setting file date
{
{ Revision 1.11  1999-03-20 18:22:11-05  kp
{ - Modified OnStartUnZip to have FName be a var parameter.
{ - Moved the OnStartUnZip call so that output filename could be changed
{
{ Revision 1.10  1999-03-17 18:25:41-05  kp
{ - Added ReplaceReadOnly property
{
{ Revision 1.9  1999-03-09 22:01:02-05  kp
{ - Fixed problem of not being able to unzip STORED files that span disks in a spanned disk set.
{ - Fixed one small problem with the ifNewer and ifOlder routine
{
{ Revision 1.8  1999-02-27 13:17:10-05  kp
{ - Added the ifNewer and ifOlder options to the OverwriteMode property
{
{ Revision 1.7  1999-02-08 21:42:48-05  kp
{ Version 2.17
{
{ Revision 1.6  1999-01-25 19:13:01-05  kp
{ Modifed compiler directives
{ }

{ 7/9/98 6:47:19 PM
{ Version 2.13
{ 
{ 1) New property ResetArchiveBitOnZip causes each file's 
{ archive bit to be turned  off after being zipped.
{ 
{ 2) New Property SkipIfArchiveBitNotSet causes files 
{ who's archive bit is not set to be skipped during zipping 
{ operations.
{ 
{ 3) A few modifications were made to allow more 
{ compatibility with BCB 1.
{ 
{ 4) Modified how directory information is used when 
{ comparing filenames to be unzipped.  Now it is always 
{ used.
}
{
{ Mon 27 Apr 1998   17:29:58
{ Removed seek in skip_rest.  Added try...except to handle 
{ exception when output file is larger than should be.
}