vclunzip.pas

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

{ ********************************************************************************** }
{                                                                                    }
{   COPYRIGHT 1997 Kevin Boylan                                                    }
{     Source File: VCLUnZip.pas                                                      }
{     Description: VCLUnZip component - native Delphi unzip component.               }
{     Date:        March 1997                                                        }
{     Author:      Kevin Boylan, [e-mail]                                 }
{                                                                                    }
{                                                                                    }
{ ********************************************************************************** }
unit VCLUnZip;

{$P-}                                                   { turn off open parameters }
{$R-}                                                   { 3/10/98 2.03 }
{$Q-}                                                   { 3/10/98 2.03 }
{$B-} { turn off complete boolean eval }                { 12/24/98  2.17 }

{$I KPDEFS.INC}

interface

uses
   {$IFDEF WIN32}
   Windows,
   {$ELSE}
   WinTypes, WinProcs,
   {$ENDIF}
   {$IFNDEF INT64STREAMS}
   kphstrms,
   {$ENDIF}
   SysUtils, Classes,
   kpSmall,
{$IFNDEF KPSMALL}
   Controls, Forms, Dialogs, FileCtrl,
{$ENDIF}
   kpCntn, kpMatch, KpLib, kpZipObj, kpzcnst;

{$I kpZTypes.Pas}

const
   kpThisVersion         = 306; {added this constant 3/1/98 for version 2.03}
   kpThisBuild           = 1;
   {$IFNDEF ZLIB114}
    ZLIB_VERSION         = '1.2.2';
   {$ELSE}
    ZLIB_VERSION         = '1.1.4';
   {$ENDIF}

   {$IFDEF WIN32}
   DEF_BUFSTREAMSIZE      = 8192;   { Changed back to 8192 7/20/01  2.21+ }
   {$ELSE}                          { Larger values can cause memory problems }
   DEF_BUFSTREAMSIZE      = 8192;   { Changed back to 8192 7/20/01  2.21+ }
   {$ENDIF}

type

   TMultiMode = (mmNone, mmSpan, mmBlocks);
   TIncompleteZipMode = (izAssumeMulti, izAssumeBad, izAssumeNotAZip);
   TUZOverwriteMode = (Prompt, Always, Never, ifNewer, ifOlder);  { added ifNewer,ifOlder 8/2/98  2.14 }
   TSkipReason = (srBadPassword, srNoOverwrite, srFileOpenError, srCreateError, srExcludeList, srArchiveBitNotSet,srNoFileToFreshen,srSkippedInStartZip);
   TSplitPartType = (spFirst, spMiddle, spLast);
   TOperationMode = (omZip, omUnZip, omNone);
   TBlockMode = (bmStandard, bmClassic);

   {Decryption}

   DecryptKey = array[0..2] of LongInt;
   DecryptHeaderPtr = ^DecryptHeaderType;
   DecryptHeaderType = array[0..11] of BYTE;

   { Exceptions }
   EVCLZipException = class(Exception);                         { 6/25/03 3.02 }
   EBadZipFile = class(EVCLZipException);
   EFileNotAllThere = class(EVCLZipException);
   EIncompleteZip = class(EVCLZipException);
   ENotAZipFile = class(EVCLZipException);
   EFatalUnzipError = class(EVCLZipException);
   EUserCanceled = class(EVCLZipException);
   EInvalidPassword = class(EVCLZipException);
   EBiggerThanUncompressed = class(EVCLZipException);          { 4/16/98 2.11 }
   ENotEnoughRoom = class(EVCLZipException);
   ECantWriteUCF = class(EVCLZipException);
   ECanceledUnzipToBuffer = class(EVCLZipException);
   EConfigFileSaveError = class(EVCLZipException);


   { Event types }

   TStartUnzipInfo = procedure(Sender: TObject; NumFiles: Integer;
      TotalBytes: Comp; var StopNow: Boolean) of object;
   TStartUnZipEvent = procedure(Sender: TObject; FileIndex: Integer;
      var FName: string; var Skip: Boolean) of object;
   TEndUnZipEvent = procedure(Sender: TObject; FileIndex: Integer; FName: string) of object;
   TFilePercentDone = procedure(Sender: TObject; Percent: LongInt) of object;
   TTotalPercentDone = procedure(Sender: TObject; Percent: LongInt) of object;
   TPromptForOverwrite = procedure(Sender: TObject; var OverWriteIt: Boolean;
      FileIndex: Integer; var FName: string) of object;
   TSkippingFile = procedure(Sender: TObject; Reason: TSkipReason; FName: string;
      FileIndex: Integer; var Retry: Boolean) of object;
   TBadPassword = procedure(Sender: TObject; FileIndex: Integer; var NewPassword: string) of
      object;
   TBadCRC = procedure(Sender: TObject; CalcCRC, StoredCRC: LongInt;
      FileIndex: Integer) of object;
   TIncompleteZip = procedure(Sender: TObject; var IncompleteMode: TIncompleteZipMode) of
      object;
   TGetNextDisk = procedure(Sender: TObject; NextDisk: Integer; var FName: string) of object;
   TUnZipComplete = procedure(sender: TObject; FileCount: Integer) of object;
   TGetNextBuffer = procedure(Sender: TObject; var Buffer: PChar; FName: string; AmountUsed:
      LongInt;
      BufferNum: Integer; var Quit: Boolean) of object;
   TDecryptEvent = procedure(Sender: TObject; buffer: BytePtr; length: Integer;
                             Password: String ) of object;
   TFileNameForSplitPartEvent = procedure(Sender: TObject; var FName: String; PartNum: Integer;
                SplitType: TSplitPartType) of object;
   THandleMessageEvent = procedure(Sender: TObject; const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord; var Return: Integer) of Object;

   {$IFNDEF WIN32}
   DWORD = LongInt;
   {$ENDIF}

   TVCLUnZip = class(TComponent)
   PRIVATE
      { Private declarations }
      FZipName: string;
      FDestDir: string;
      FSortMode: TZipSortMode;
      FReCreateDir: Boolean;
      FOverwriteMode: TUZOverwriteMode;
      FFilesList: TStrings;
      FDoAll: Boolean;
      FPassword: string;
      FIncompleteZipMode: TIncompleteZipMode;
      FKeepZipOpen: Boolean;
      FDoProcessMessages: Boolean;
      FNumDisks: Integer;
      FRetainAttributes: Boolean;
      FThisVersion: Integer;
      FThisBuild: Integer;
      FReplaceReadOnly: Boolean;
      FNumSelected: Integer;
      FBufferLength: LongInt;                           { 8/23/99  2.18+ }
      FImproperZip: Boolean;                            { 2/19/00  2.20+ }
      FEncryptBeforeCompress: Boolean;                  { 12/9/01 2.22+ }
      FOEMConvert: TOEMConvert;                             { 2/17/02 2.22+ }

      { Event variables }
      FOnStartUnzipInfo: TStartUnzipInfo;
      FOnStartUnZip: TStartUnZipEvent;
      FOnEndUnZip: TEndUnZipEvent;
      FOnPromptForOverwrite: TPromptForOverwrite;
      FOnBadPassword: TBadPassword;
      FOnBadCRC: TBadCRC;
      FOnInCompleteZip: TInCompleteZip;
      FOnUnzipComplete: TUnZipComplete;
      FOnGetNextBuffer: TGetNextBuffer;
      FOnDecrypt: TDecryptEvent;

      function ProcessIntegrityCheck(Index: Integer): Boolean; { 8/15/99 2.18+ }

      { Decrypt }
   PROTECTED
      FOnFilePercentDone: TFilePercentDone;
      FOnTotalPercentDone: TTotalPercentDone;
      FOnSkippingFile: TSkippingFile;
      FOnGetNextDisk: TGetNextDisk;
      FOnFileNameForSplitPart: TFileNameForSplitPartEvent;
      FOnHandleMessage: THandleMessageEvent;
      FArchiveStream: TkpStream;
      FArchiveTStream: TStream;
      FOperationMode: TOperationMode;
      FBlockMode: TBlockMode;
      FBusy: Boolean;
      FRootDir: string;
      FRelativePathList: TStrings;
      FTestMode: Boolean;                               { 12/3/98  2.17P+ }
      FFlushFilesOnClose: Boolean;                      { 10/11/99 2.18+ }
      FBufferedStreamSize: Integer;                    { 05/13/00 2.20+ }
      ArchiveIsStream: Boolean;
      FCheckDiskLabels: Boolean;
      FMultiMode: TMultiMode;
      file_info: TZipHeaderInfo;
      files: TSortedZip;
      sortfiles: TSortedZip;
      filesDate: TDateTime;
      ZipIsBad: Boolean;
      CurrentDisk: LongWord;
      theZipFile: TkpStream;
      Crc32Val: U_LONG;
      lrec: local_file_header;
      {crec: central_file_header;}                      { Removed 4/22/02 2.23+ }
      ecrec: TEndCentral;
      ZipCommentPos: BIGINT;
      UnZippingSelected: Boolean;                       { 6/27/99 2.18+ }

      tmpMStr: string;
      Key: DecryptKey;
      CancelOperation: Boolean;
      PauseOperation: Boolean;
      ZipStream: TkpStream;
      StreamZipping: Boolean;
      MemZipping: Boolean;
      MemBuffer: PChar;
      MemLen: BIGINT;
      MemLeft: BIGINT;
      CurrMem: PChar;
      Fixing: Boolean;
      DR: Boolean;
      FZipNameNoExtension: string;


      TotalUncompressedSize: Comp;
      TotalBytesDone: Comp;

      procedure OpenZip;
      procedure CloseZip;
      function GetCount: Integer;
      procedure GetFileInfo(infofile: TkpStream);
      function GetZipName: string;
      procedure SetZipName(ZName: string); VIRTUAL;
      procedure SetArchiveStream(theStream: TkpStream);
      function GetDestDir: string;
      procedure SetDestDir(DDir: string);
      procedure SetRootDir(Value: string);
      function StripRelativePath( var path: String ): String;
      function UnZipFiles(zip_in_file: TkpStream): Integer;
      function UpdCRC(Octet: Byte; Crc: U_LONG): U_LONG;
      function SwapDisk(NewDisk: Integer): TkpStream;
      procedure SetFileComment(Index: Integer; theComment: string);
      procedure SetZipComment(theComment: string);
      procedure WriteNumDisks(NumberOfDisks: Integer);
      procedure NewDiskEvent(Sender: TObject; var S: TkpStream);
      procedure SetThisVersion(v: Integer);
      procedure SetThisBuild(b: Integer);
      function GetCheckDiskLabels: Boolean; VIRTUAL;
      procedure SetCheckDiskLabels(Value: Boolean); VIRTUAL;
      function CreateNewZipHeader: TZipHeaderInfo;
      function SetBusy( value: Boolean ): Boolean;
      function SetOperationMode( value: TOperationMode ): TOperationMode;



      { GetMultiMode and SetMultiMode added 3/10/98 for 2.03}
      function GetMultiMode: TMultiMode; VIRTUAL;
      procedure SetMultiMode(Value: TMultiMode); VIRTUAL;

      { List functions }
      procedure SetFilesList(Value: TStrings);
      function GetFilename(Index: Integer): TZipFilename;
      function GetPathname(Index: Integer): TZipPathname;
      function GetFullname(Index: Integer): string;
      function GetCompressMethod(Index: Integer): WORD;
      function GetCompressMethodStr(Index: Integer): string;
      function GetDateTime(Index: Integer): TDateTime;
      function GetCrc(Index: Integer): U_LONG;
      function GetCompressedSize(Index: Integer): BIGINT;
      function GetUnCompressedSize(Index: Integer): BIGINT;
      function GetExternalFileAttributes(Index: Integer): U_LONG;
      function GetIsEncrypted(Index: Integer): Boolean;
      function GetHasComment(Index: Integer): Boolean;
      function GetFileComment(Index: Integer): string;
      function GetFileIsOK(Index: Integer): Boolean;    { 12/3/98  2.17P+ }
      function GetDiskNo(Index: Integer): Integer;
      function GetSelected(Index: Integer): Boolean;    {6/27/99 2.18+ }
      procedure SetSelected(Index: Integer; Value: Boolean);
      {$IFDEF ISDELPHI}
      function GetDecryptHeader(Index: Integer): DecryptHeaderType;
      {$ENDIF}
      function GetZipHasComment: Boolean;
      function GetZipComment: string;
      function GetZipSize: BIGINT;
      function GetIsZip64: Boolean;

      {Decryption}
      function DecryptTheHeader(Passwrd: string; zfile: TkpStream): BYTE;
      procedure update_keys(ch: char);
      function decrypt_byte: BYTE;
      procedure Init_Keys(Passwrd: string);
      procedure Update_CRC_buff(bufptr: BYTEPTR; num_to_update: LongInt);
      procedure DoFileNameForSplitPart(var FName: String; PartNum: Integer;
                SplitType: TSplitPartType);
      procedure DoGetNextDisk(NextDisk: Integer; var FName: string);
      function DoHandleMessage(const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord ): Integer;


      procedure Loaded; OVERRIDE;

      procedure DoPause;

   PUBLIC
      { Public declarations }
      constructor Create(AOwner: TComponent); OVERRIDE;
      destructor Destroy; OVERRIDE;
      procedure Assign(Source: TPersistent); OVERRIDE;  { 6/27/99 2.18+ }
      procedure ReadZip;
      function UnZip: Integer;
      function UnZipSelected: Integer;
      procedure ClearSelected;
      procedure ClearZip;
      procedure FillList(FilesList: TStrings);
      procedure Sort(SMode: TZipSortMode);
      procedure CancelTheOperation;
      procedure PauseTheOperation;
      procedure RestartTheOperation;
      procedure AskForNewDisk(NewDisk: Integer);
      procedure DefaultGetNextDisk(Sender: TObject; NextDisk: Integer; var FName: string);
      procedure DefaultFileNameForSplitPart(Sender: TObject; var FName: String; PartNum: Integer;
                SplitType: TSplitPartType);
      function DefaultHandleMessage(const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord): Integer;
      function UnZipToStream(theStream: TkpStream; FName: string): Integer;
      {$IFNDEF INT64STREAMS} overload;
      function UnZipToStream(theStream: TMemoryStream; FName: string): Integer; overload;
      function UnZipToStreamByIndex(theStream: TStream; Index: Integer): Integer; overload;
      {$ENDIF}
      function UnZipToStreamByIndex(theStream: TkpStream; Index: Integer): Integer;
      {$IFNDEF INT64STREAMS} overload;
      {$ENDIF}
      function UnZipToBuffer(var Buffer: PChar; FName: string): Integer;
      function UnZipToBufferByIndex(var Buffer: PChar; Index: Integer): Integer;

      procedure ZLibDecompressStream(inStream, outStream: TStream; HttpCompression: Boolean = False);
      procedure ZLibDecompressBuffer(const inBuffer: Pointer; inSize: Integer;
                  out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0; HttpCompression: Boolean = False);
      function ZLibDecompressString(const s: string; HttpCompression: Boolean = False): String;

      procedure ResetFileIsOK(Index: Integer);
      function CheckArchive: Boolean;
      function DecryptHeaderByte(Passwrd: string; dh: DecryptHeaderType): BYTE;
      procedure decrypt_buff(bufptr: BYTEPTR; num_to_decrypt: LongInt);
      { The following two are for BCB because of difficulties passing the DecryptHeaderType }
      procedure GetDecryptHeaderPtr(Index: Integer; dhPtr: BytePtr); { 8/8/99  2.18+ }
      function DecryptHeaderByteByPtr(Passwrd: string; dh: BytePtr): Byte; { 8/8/99  2.18+ }
      { -------- }
      property ArchiveStream: TkpStream READ theZipFile WRITE SetArchiveStream;
      property Count: Integer READ GetCount;
      property Filename[Index: Integer]: TZipFilename READ GetFilename;
      property Pathname[Index: Integer]: TZipPathname READ GetPathname;
      property FullName[Index: Integer]: string READ GetFullName;
      property CompressMethod[Index: Integer]: WORD READ GetCompressMethod;
      property CompressMethodStr[Index: Integer]: string READ GetCompressMethodStr;
      property DateTime[Index: Integer]: TDateTime READ GetDateTime;
      property Crc[Index: Integer]: U_LONG READ GetCrc;
      property CompressedSize[Index: Integer]: BIGINT READ GetCompressedSize;
      property UnCompressedSize[Index: Integer]: BIGINT READ GetUnCompressedSize;
      property ExternalFileAttributes[Index: Integer]: U_LONG READ GetExternalFileAttributes;
      property IsEncrypted[Index: Integer]: Boolean READ GetIsEncrypted;
      property FileHasComment[Index: Integer]: Boolean READ GetHasComment;
      property FileComment[Index: Integer]: string READ GetFileComment;
      property FileIsOK[Index: Integer]: Boolean READ GetFileIsOK; { 12/3/98 2.17P+ }
      property DiskNo[Index: Integer]: Integer READ GetDiskNo;
      property Selected[Index: Integer]: Boolean READ GetSelected WRITE SetSelected;  { 6/27/99 2.18+ }
      property ZipComment: string READ GetZipComment;
      property Password: string READ FPassword WRITE FPassword;
      property ZipHasComment: Boolean READ GetZipHasComment;
      property NumDisks: Integer READ FNumDisks;
      property ZipSize: BIGINT READ GetZipSize;
      property CheckDiskLabels: Boolean READ GetCheckDiskLabels WRITE SetCheckDiskLabels DEFAULT
         True;
      property MultiMode: TMultiMode READ GetMultiMode WRITE SetMultiMode DEFAULT mmNone;
      property Busy: Boolean READ FBusy DEFAULT False;
      {$IFDEF ISDELPHI}
      property DecryptHeader[Index: Integer]: DecryptHeaderType READ GetDecryptHeader;
      {$ENDIF}
      property NumSelected: Integer READ FNumSelected;
      property BufferLength: LongInt READ FBufferLength WRITE FBufferLength DEFAULT 0;
      property ImproperZip: Boolean READ FImproperZip DEFAULT False;  { 2/19/00  2.20+ }
      property BufferedStreamSize: Integer READ FBufferedStreamSize
                 WRITE FBufferedStreamSize DEFAULT DEF_BUFSTREAMSIZE;
      property EncryptBeforeCompress: Boolean read FEncryptBeforeCompress write FEncryptBeforeCompress
                 default False;
      property OperationMode: TOperationMode read FOperationMode;
      property isZip64: Boolean read GetIsZip64;

   PUBLISHED
      { Published declarations }
      property ThisVersion: Integer READ FThisVersion WRITE SetThisVersion DEFAULT
         kpThisVersion;
      property ThisBuild: Integer READ FThisBuild WRITE SetThisBuild DEFAULT
         kpThisBuild;
      property ZipName: string READ GetZipName WRITE SetZipName;
      property DestDir: string READ GetDestDir WRITE SetDestDir;
      property RootDir: string READ FRootDir WRITE SetRootDir;
      property RelativePathList: TStrings READ FRelativePathList WRITE FRelativePathList;
      property SortMode: TZipSortMode READ FSortMode WRITE FSortMode DEFAULT ByNone;
      property RecreateDirs: Boolean READ FRecreateDir WRITE FRecreateDir DEFAULT False;
      property OverwriteMode: TUZOverwriteMode READ FOverwriteMode
         WRITE FOverwriteMode DEFAULT Prompt;
      property FilesList: TStrings READ FFilesList WRITE SetFilesList;
      property DoAll: Boolean READ FDoAll WRITE FDoAll DEFAULT False;
      property IncompleteZipMode: TIncompleteZipMode READ FIncompleteZipMode
         WRITE FIncompleteZipMode DEFAULT izAssumeMulti;
      property KeepZipOpen: Boolean READ FKeepZipOpen WRITE FKeepZipOpen DEFAULT False;
      property DoProcessMessages: Boolean READ FDoProcessMessages WRITE FDoProcessMessages
         DEFAULT True;
      property RetainAttributes: Boolean READ FRetainAttributes WRITE FRetainAttributes DEFAULT
         True;
      property ReplaceReadOnly: Boolean READ FReplaceReadOnly WRITE FReplaceReadOnly DEFAULT