kpunzipp.pas

delphi实现 webservice的例子.有服务端和客户段 利用xml交互.

 finfo: TZipHeaderInfo;
 StopNow: Boolean;
 CompareFileName: String;
 SaveSortMode: TZipSortMode;
 SaveKeepZipOpen: Boolean;
 OldOperationMode: TOperationMode;
 {FinishedOK: Boolean;}
begin
  {FinishedOK := False;}  { 5/18/98  2.13 }
  {Result := 0;}          { 5/18/98  2.13 }
 OldOperationMode := SetOperationMode(omUnZip);
 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
      if DoProcessMessages then
      begin
        YieldProcess;
        if CancelOperation then
        begin
          CancelOperation := False;
          raise EUserCanceled.Create(LoadStr(IDS_CANCELOPERATION));
        end;
      end;
     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 if (not DoAll) then
      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
     else
      finfo.MatchFlag := True;
     { 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;
  setOperationMode(OldOperationMode);
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: TkpStream ): 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:  10054: kpUnzipp.pas 
{
{   Rev 1.0    8/14/2005 1:10:08 PM  KLB    Version: VCLZip Pro 3.06
{ Initial load of VCLZip Pro on this computer
}
{
{   Rev 1.16.1.3    4/2/2005 4:58:22 PM  Supervisor    Version: VCLZip 3.X
{ ZLib 1.2.2 default
{ Fixed ZLibDecompressStream
{ Delphi 2005 compatible
{ Other assorted bug fixes
}
{
{   Rev 1.16.1.2    7/22/2004 12:41:02 PM  Supervisor    Version: VCLZip 3.X
{ Fixed greater than 65K files problem
{ Fixed problem when CD spanned parts
{ Fixed OperationMode settings
{ Fixed Zip64 EOCL
}
{
{   Rev 1.16.1.1    7/19/2004 7:56:04 PM  Supervisor    Version: VCLZip 3.X
{ Fixed problem with GetSize.
}
{
{   Rev 1.16.1.0    11/1/2003 2:27:28 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.16    10/8/2003 10:16:52 PM  Supervisor    Version: VCLZip 3.X
{ Fixed CancelTheOperation exception when unzipping
}
{
{   Rev 1.15    9/17/2003 7:40:22 AM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.14    9/7/2003 9:38:30 AM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.13    9/3/2003 7:07:46 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.12    8/26/2003 10:45:16 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.11    8/26/2003 8:58:08 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.10    8/19/2003 7:40:14 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.9    8/12/2003 5:23:48 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.8    8/7/2003 11:31:44 PM  Supervisor    Version: VCLZip 3.X
}
{
{   Rev 1.7    6/25/2003 6:16:56 PM  Kevin    Version: VCLZip 3.X
}
{
{   Rev 1.6    5/20/2003 4:44:24 PM  Supervisor
}
{
{   Rev 1.5    5/19/2003 10:45:04 PM  Supervisor
{ After fixing streams.  VCLZip still uses ErrorRpt.  Also added setting of
{ capacity on the sorted containers to alleviate the memory problem caused by
{ growing array.
}
{
{   Rev 1.4    5/3/2003 6:33:32 PM  Supervisor
}
{
{   Rev 1.3    2/13/2003 10:55:40 AM  Supervisor
{ Added DoProcessing Messages to check for which files to be unzipped.
}
{
{   Rev 1.2    1/29/2003 10:30:04 PM  Supervisor
{ Added pause feature
}
{
{   Rev 1.1    1/4/2003 1:53:32 PM  Supervisor
}
{
{   Rev 1.0    10/15/2002 8:15:20 PM  Supervisor
}
{
{   Rev 1.3    9/18/2002 12:45:46 PM  Supervisor
{ Added ZLib
}
{
{   Rev 1.2    9/7/2002 8:48:50 AM  Supervisor
{ Last modifications for FILE_INT
}
{
{   Rev 1.1    9/3/2002 10:39:30 PM  Supervisor
{ Changed appropriate longints to FILE_INTS
}
{
{   Rev 1.0    9/3/2002 8:16:52 PM  Supervisor
}
{ 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.
}