Night Owl 25/nopv25.iso/040A/DELZIP10.ZIP/VCL.ZIP/ZIPMSTR.PAS

Pascal/Delphi Source File | 1997-04-07 | 43.3 KB | 1,157 lines

Unit ZipMstr;
(* TZipMaster VCL by Eric W. Engler.   v1.00    April 3, 1997
   A Delphi v2 wrapper for my freeware ZIP and UNZIP DLLs.  At run
   time, the DLL's: ZIPDLL.DLL and UNZDLL.DLL must be present on the
   hard disk - preferrably in C:\WINDOWS\SYSTEM (or else in your
   application directory, or a directory in the PATH).

   The DLLs are based on the InfoZip Official Freeware Zip/Unzip code:
               http://www.cdrom.com/pub/infozip/
   I have customized the DLL interface especially for use with Delphi.
   These customizations are fully compatible with the C/C++ language, also.

   VB users: unless version 5 of VB fixes the DLL interface issues, my
   DLLs won't work for you.  Custom "helper" DLL functions would allow
   the use of my DLLs with VB, but this is not my area of expertise.

   The five methods that can be invoked are:
       add      - add one or more files to a ZIP archive
       delete   - delete one or more files from ZIP archive
       extract  - expand one or more files from a ZIP archive
       list     - transfer "table of contents" of ZIP archive
                  to a StringList
       copyfile - copies a file

   Various properties exist to control the actions of the methods.

   Filespecs are specified in the FSpecArgs TStringList property, so you
   can easily combine many different filespecs into one Add, Delete, or
   Extract operation. For example:

      1. Add entries directly to the FSpecArgs property:
       ZipMaster1.FSpecArgs.Add('C:\AUTOEXEC.BAT');
       ZipMaster1.FSpecArgs.Add('C:\DELPHI\BIN\DELPHI.EXE');
       ZipMaster1.FSpecArgs.Add('C:\WINDOWS\*.INI');

      2. Take the filespecs from a StringList, just assign them all over
         to ZipMaster1.
       ZipMaster1.FSpecArgs.Assign(StringList1);

      3. Take the filespecs from a ListBox, just assign them all over
         to ZipMaster1.
       ZipMaster1.FSpecArgs.Assign(ListBox1.Items);

   You can specify either the MS-DOS backslash path symbol, or the one
   normally used by PKZIP (the Unix path separator: /).  They are treated
   exactly the same.

   All of your FSpecArgs accept MS-DOS wildcards.

   Add, Delete, and Extract are the only methods that use FSpecArgs.
   The List method doesn't - it just lists all files.


   Following is a list of all TZipMaster properties, events and methods:

   Properties
   ==========
     Verbose      Boolean     If True, ask for the maximum amount of "possibly
                              important" information from the DLLs.  The
                              informational messages are delivered to your
                              program via the OnMessage event, and the ErrCode
                              and Message properties. This is primarily used
                              to determine how much info you want to show your
                              "end-users" - developers can use the Trace
                              property to get additional infomation.

     Trace        Boolean     Similar to Verbose, except that this one is
                              aimed at developers.  It lets you trace the
                              execution of the C code in the DLLs.  Helps
                              you locate possible bugs in the DLLs, and
                              helps you understand why something is happening
                              a certain way.

     ErrCode      Integer     Holds a copy of the last error code sent to
                              your program by from DLL. 0=no error.
                              See the OnMessage event.  Most messages from
                              the DLLs will have an ErrCode of 0.

     Message      String      Holds a copy of the last message sent to your
                              program by the DLL.  See the OnMessage event.

     ZipContents  TList       Read-only TList that contains the directory
                              of the archive specified in the ZipFileName
                              property. Every entry in the list points to
                              a ZipDirEntry record.  This is automatically
                              filled with data whenever an assignment is
                              made to ZipFileName, and can be manually
                              filled by calling the List method.
                                 For your convenience, this VCL hides the
                              TList memory allocation issues from you.
                                 Automatic updates to this list occur
                              whenever this VCL changes the ZIP file.
                              Event OnDirUpdate is triggered for you
                              each time this list is updated - that is
                              your queue to refresh your directory display.

     ExtrBaseDir  String      This base directory applies only to "Extract"
                              operations.  The UNZIP DLL will "CD" to this
                              directory before extracting any files. If you
                              don't specify a value for this property, then the
                              directory of the ZipFile itself will be the
                              base directory for extractions.

     Cancel       Boolean     If you set this to True, it will abort any
                              Add or Extract processing now underway.  There
                              may be a slight delay before the abort will
                              take place.  Note that a ZIP file can be
                              corrupted if an Add operation is aborted.

     ZipBusy      Boolean     If True, a ZIP operation in underway - you
                              must delay your next Add/Delete operation
                              until this is False.  You won't need to be
                              concerned about this in most applications.

     UnzBusy      Boolean     If True, an UNZIP operation in underway -
                              you must delay your next Extract operation
                              until this is False.  You won't need to be
                              concerned about this in most applications.

     AddOptions   Set         This property is used to modify the default
                              action of the Add method.  This is a set of
                              options.  If you want an option to be True,
                              you need to add it to the set.  This is
                              consistant with the way Delphi deals with
                              "options" properties in general.

        AddDirNames           If True, saves the pathname with each fname.
                              Names of empty directories in any fspec are
                              also stored inside the archive.  Drive IDs
                              are never stored in ZIP file directories.
                              NOTE: the root directory name is never
                              stored in a pathname; in other words, the
                              first character of a pathname stored in the
                              zip file's directory will never be a slash.

        RecurseDirs           If True, subdirectories below EACH given fspec
                              will be included in the fspec. Defaults to False.
                              This is potentially dangerous if the user does
                              this from the root directory (his hard drive
                              may fill up with a huge zip file)!

        Move                  If True, after adding to archive, delete orig
                              file.  Potentially dangerous.  Use with caution!

        NOTE: You can not have more than one of the following three options
              set to "True".  If all three are False, then you get a standard
              "add": all files in the fspecs will be added to the archive
              regardless of their date/time stamp.  This is also the default.

        AddFreshen            If True, add newer files to archive (only for
                              files that are already in the archive).

        AddUpdate             If True, add newer files to archive (but, any
                              file in an fspec that isn't already in the
                              archive will also be added).


     ExtrOptions  set         This property is used to modify the default
                              action of the Extract method.  This is a set
                              of options.  If you want an option to be
                              True, you need to add it to the set.

        ExtrDirNames          If True, extracts and recreates the relative
                              pathname that may have been stored with each file.
                              Empty dirs stored in the archive (if any) will
                              also be recreated.

        OverWrite             If True, overwrite any pre-existing files during
                              Extraction.

        ExtrFreshen           If True, add newer files to archive (only for
                              files that are already in the archive).

        ExtrUpdate            If True, add newer files to archive (but, any
                              file in an fspec that isn't already in the
                              archive will also be added).

     FSpecArgs    TStrings    Stringlist containing all the filespecs used
                              as arguments for Add, Delete, or Extract
                              methods. Every entry can contain MS-DOS wildcards.
                              If you give filenames without pathnames, or if
                              you use relative pathnames with filenames, then
                              the base drive/directory is assumed to be that
                              of the Zipfile.

     ZipFileName  String      Pathname of a ZIP archive file.  If the file
                              doesn't already exist, you will only be able to
                              use the Add method.  I recommend using a fully
                              qualified pathname in this property, unless
                              your program can always ensure that a known
                              directory will be the "current" directory.

     Count        Integer     Number of files now in the Zip file.  Updated
                              automatically, or manually via the List method.

     SuccessCnt   Integer     Number of files that were successfully
                              operated on (within the current ZIP file).
                              You can read this after every Add, Delete, and
                              Extract operation.

     MajZipVers   ShortInt     The major version number of the ZIPDLL.DLL.

     MinZipVers   ShortInt     The minor version number of the ZIPDLL.DLL.

     MajUnzVers   ShortInt     The major version number of the UNZDLL.DLL.

     MinUnzVers   ShortInt     The minor version number of the UNZDLL.DLL.

   Events
   ======
     OnDirUpdate              Occurs immed. after this VCL refreshes it's
                              TZipContents TList.  This is your queue to
                              update the screen with the new contents.

     OnProgress               Occurs during compression and decompression.
                              Intended for "status bar" or "progress bar"
                              updates.  Criteria for this event:
                                - starting to process a new file (gives you
                                    the filename and total uncompressed
                                    filesize)
                                - every 32K bytes while processing
                                - completed processing on a batch of files

     OnMessage                Occurs when the DLL sends your program a message.
                              The Message argument passed by this event will
                              contain the message. If an error code
                              accompanies the message, it will be in the
                              ErrCode argument.
                                 The Verbose and Trace properties have a
                              direct influence on how many OnMessage events
                              you'll get.
                                 See Also: Message and ErrCode properties.
   Methods
   =======
     Add                      Adds all files specified in the FSpecArgs
                              property into the archive specified by the
                              ZipFileName property.
                                Files that are already compressed will not be
                              compressed again, but will be stored "as is" in
                              the archive. This applies to .GIF, .ZIP, .LZH,
                              etc. files. Note that .JPG files WILL be
                              compressed, since they can still be squeezed
                              down in size by a notable margin.

     Extract                  Extracts all files specified in the FSpecArgs
                              property from the archive specified by the
                              ZipFilename property. If you don't specify
                              any FSpecArgs, then all files will be extracted.

     Delete                   Deletes all files specified in the FSpecArgs
                              property from the archive specified by the
                              ZipFilename property.

     List                     Refreshes the contents of the archive into
                              the ZipContents TList property.  This is
                              a manual "refresh" of the "Table of Contents".

     CopyFile                 This copies any file to any other file.
                              Useful in many application programs, so
                              it was included here as a method.  This returns
                              0 on success, or else one of these errors:
                                    -1   error in open of outfile
                                    -2   read or write error during copy
                                    -3   error in open of infile
                                    -4   error setting date/time of outfile
                              Can be used to make a backup copy of the
                              ZipFile before an Add operation.
                              Sample Usage:
                                with ZipMaster1 do
                                begin
                                   ret=CopyFile(ZipFileName, 'C:\$$$$$.ZIP');
                                   if ret < 0 then
                                      ShowMessage('Error making backup');
                                end;

   Example of how to copy a file:
     Showmessage('result of copyfile: ' + IntToStr(
        ZipMaster1.CopyFile('C:\borlandc\bin\bcc.exe','c:\bcc.exe')));

     DLL usage for each method:
       Add        ZIPDLL.DLL
       Delete     ZIPDLL.DLL
       Extract    UNZDLL.DLL
       List         none
       CopyFile     none
*)
interface

uses
  WinTypes, WinProcs, SysUtils, Classes, Messages, Dialogs, Controls, FileCtrl,
  ZipDLL, UnzDLL, ZCallBck;

type
  EInvalidOperation = class(exception);

type ZipDirEntry = packed Record
  Version                     : WORD;
  Flag                        : WORD;
  CompressionMethod           : WORD;
  DateTime                    : Longint; { Time: Word; Date: Word; }
  CRC32                       : Longint;
  CompressedSize              : Longint;
  UncompressedSize            : Longint;
  FileNameLength              : WORD;
  ExtraFieldLength            : WORD;
  FileName                    : String;
end;

type
  PZipDirEntry = ^ZipDirEntry;

const
  LocalFileHeaderSig   = $04034b50; { 'PK03' }
  CentralFileHeaderSig = $02014b50; { 'PK12' }
  EndCentralDirSig     = $06054b50; { 'PK56' }

type
  ProgressType = ( NewFile, ProgressUpdate, EndOfBatch );

  AddOptsEnum = ( AddDirNames, RecurseDirs, Move, AddFreshen, AddUpdate );
  AddOpts = set of AddOptsEnum;

  ExtrOptsEnum = ( ExtrDirNames, OverWrite, ExtrFreshen, ExtrUpdate );
  ExtrOpts = set of ExtrOptsEnum;

  TProgressEvent = procedure(Sender : TObject;
          ProgrType: ProgressType;
          FileName: String;
          FileSize: Longint) of object;

  TMessageEvent = procedure(Sender : TObject;
          ErrCode: Integer;
          Message : String) of object;

  TZipMaster = class(TWinControl) { We need a window handle for DLL }
  private
    { Private versions of property variables }
    FVerbose:      Boolean;
    FTrace:        Boolean;
    FErrCode:      Integer;
    FMessage:      String;
    FZipContents:  TList;
    FExtrBaseDir:  String;
    FCancel:       Boolean;
    FZipBusy:      Boolean;
    FUnzBusy:      Boolean;
    FAddOptions:   AddOpts;
    FExtrOptions:  ExtrOpts;
    FFSpecArgs:    TStrings;
    FZipFileName:  String;
    FSuccessCnt:   Integer;

    { misc private vars }
    ZipParms1: ZipParms;     { declare an instance of ZipParms }
    UnZipParms1: UnZipParms; { declare an instance of UnZipParms }

    { Event variables }
    FOnDirUpdate    : TNotifyEvent;
    FOnProgress     : TProgressEvent;
    FOnMessage      : TMessageEvent;

    { Property get/set functions }
    function  GetCount: Integer;
    function  GetMajZipVers: ShortInt;
    function  GetMinZipVers: ShortInt;
    function  GetMajUnzVers: ShortInt;
    function  GetMinUnzVers: ShortInt;
    procedure SetFSpecArgs(Value : TStrings);
    procedure SetFileName(Value: String);

    { Private "helper" functions }
    function  AppendSlash(const sDir : String): String;
    procedure FreeZipDirEntryRecords;
    procedure SetZipSwitches;
    procedure SetUnZipSwitches;

  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure WMPaint (var Message : TMessage); message WM_PAINT;

    { Public Properties (run-time only) }
    property ErrCode:      Integer   read FErrCode;
    property Message:      String    read FMessage;
    property ZipContents:  TList     read FZipContents;
    property Cancel:       Boolean   read FCancel
                                     write FCancel;
    property ZipBusy:      Boolean   read FZipBusy;
    property UnzBusy:      Boolean   read FUnzBusy;

    property Count:        Integer   read GetCount;
    property SuccessCnt:   Integer   read FSuccessCnt;

    property MajZipVers:   ShortInt  read GetMajZipVers;
    property MinZipVers:   ShortInt  read GetMinZipVers;
    property MajUnzVers:   ShortInt  read GetMajUnzVers;
    property MinUnzVers:   ShortInt  read GetMinUnzVers;

    { Public Methods }
    procedure Add;
    procedure Delete;
    procedure Extract;
    procedure List;
    function CopyFile(const src, dest: String):Integer;

  published
    { Public properties that also show on Object Inspector }
    property Verbose:      Boolean  read FVerbose
                                    write FVerbose;
    property Trace:        Boolean  read FTrace
                                    write FTrace;
    property ExtrBaseDir:  String   read FExtrBaseDir
                                    write FExtrBaseDir;
    property AddOptions:   AddOpts  read FAddOptions
                                    write FAddOptions;
    property ExtrOptions:  ExtrOpts  read FExtrOptions
                                     write FExtrOptions;
    property FSpecArgs:    TStrings  read FFSpecArgs
                                     write SetFSpecArgs;
    { At runtime: every time the filename is assigned a value, the
      ZipDir will be read.  You don't need to call ReadZipDir yourself,
      unless you just want to refresh your list. }
    property ZipFileName: String  read FZipFileName
                                  write SetFileName;

    { Events }
    property OnDirUpdate         : TNotifyEvent   read FOnDirUpdate
                                                  write FOnDirUpdate;
    property OnProgress          : TProgressEvent read FOnProgress
                                                  write FOnProgress;
    property OnMessage           : TMessageEvent  read FOnMessage
                                                  write FOnMessage;
  end;

procedure Register;

{ The callback function must NOT be a member of a class }
{ We use the same callback function for ZIP and UNZIP }
function ZCallback(ZCallBackRec: PZCallBackStruct): LongBool; stdcall; export;
function StripJunkFromString(s: String): String;

implementation

const
  LocalDirEntrySize = 26;   { size of zip dir entry in local zip directory }

{ Dennis Passmore (Compuserve: 71640,2464) contributed the idea of passing an
  instance handle to the DLL, and, in turn, getting it back from the callback.
  This lets us referance variables in the TZipMaster class from within the
  callback function.  Way to go Dennis! }
function ZCallback(ZCallBackRec: PZCallBackStruct): LongBool; stdcall; export;
var
  Msg: String;
begin
   with ZCallBackRec^, (TObject(Caller) as TZipMaster) do
   begin
      if ActionCode = 1 then
         { progress type 1 = starting any ZIP operation on a new file }
         if assigned(FOnProgress) then
            FOnProgress(Caller, NewFile, StrPas(FileNameOrMsg), FileSize);

      if ActionCode = 2 then
         { progress type 2 = increment bar }
         if assigned(FOnProgress) then
            FOnProgress(Caller, ProgressUpdate, ' ', 0);

      if ActionCode = 3 Then
         { end of a batch of 1 or more files }
         if assigned(FOnProgress) then
            FOnProgress(Caller, EndOfBatch, ' ', 0);

      if ActionCode = 4 Then
         { show a routine status message }
         if assigned(FOnMessage) then
         begin
            Msg:=StripJunkFromString(StrPas(FileNameOrMsg));
            FOnMessage(Caller, ErrorCode, Msg);
         end;

      { If you return TRUE, then the DLL will abort it's current
        batch job as soon as it can. }
      if fCancel then
         result:=True
      else
         result:=False;
    end; { end with }
end;

function StripJunkFromString(s: String): String;
var
   EndPos: Integer;
begin
   { Remove possible trailing CR or LF }
   EndPos:=Length(s);
   if ((s[EndPos] = #13)
    or (s[EndPos] = #10)) then
       s[EndPos] := #0;
   if EndPos > 1 then
   begin
      if ((s[EndPos-1] = #13)
       or (s[EndPos-1] = #10)) then
          s[EndPos-1] := #0;
   end;
   result:=s;
end;

constructor TZipMaster.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FZipContents:=TList.Create;
  FFSpecArgs := TStringList.Create;
  FZipFileName := '';
  fSuccessCnt:=0;
  Height:=28;  { bitmap size of pseudo-icon on form at design time }
  Width:=28;
end;

destructor TZipMaster.Destroy;
begin
  FreeZipDirEntryRecords;
  FZipContents.Free;
  FFSpecArgs.Free;
  inherited Destroy;
end;

{ Paint the 24x24 bitmap onto form at design time. I call this a pseudo-icon.
  We'll use the same bitmap used to paint the pseudo-icon in the VCL palette.
  This code is needed bec. we're descending from TWinControl, which is pretty
  high up the inheritance ladder.  We're descending from TWinControl to minimize
  the VCL overhead at runtime, while still allowing us to have a window handle. }
procedure TZipMaster.WMPaint (var Message : TMessage);
var
  PS : TPaintStruct;
  MyBrush : HBrush;
  MyPen : HPen;
  MyBitmap : HBitmap;
  bmpDC : HDC;
begin
  { Size of VCL "pseudo-icon" set in Create to have width and height of 28. }
  { This gives us a 2 pixel 3-D border around a 24x24 bitmap. }
  { This paint procedure makes the "pseudo-icon" look exactly the same as
    those made automatically by Delphi 2 "heavier weight" classes. }

  { buttonhighlight = white }
  { buttonface      = light gray }
  { buttonshadow    = dark gray }

  BeginPaint (Handle, PS);
  if csDesigning in ComponentState then
  begin
    { draw a black border, and fill the inside with light gray }
    MyPen   := SelectObject (PS.HDC,
                   GetStockObject (BLACK_PEN));
    MyBrush := SelectObject (PS.HDC,
                   CreateSolidBrush (GetSysColor (COLOR_BTNFACE)));
    with ClientRect do
       Rectangle (PS.HDC, Left, Top, Right, Bottom);

    { write a white line on left and top sides of the black border }
    SelectObject(PS.HDC, CreatePen(PS_SOLID, 1,
                                GetSysColor(COLOR_BTNHIGHLIGHT)));
    MoveToEx (PS.HDC, 0, ClientRect.Bottom - 2, NIL);
    LineTo (PS.HDC, 0, 0);
    LineTo (PS.HDC, ClientRect.Right - 1, 0 );

    { write a dark gray shadow just inside the bottom and right sides }
    DeleteObject(SelectObject (PS.HDC,
                      CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))));
    MoveToEX (PS.HDC, ClientRect.Right - 2, 1, NIL);
    LineTo (PS.HDC, ClientRect.Right - 2, ClientRect.Bottom - 2);
    LineTo (PS.HDC, 0, ClientRect.Bottom - 2);

    { border is done, now we'll get the bitmap inside it }
    bmpDC := CreateCompatibleDC (PS.HDC);
    { The name of the bitmap below must match the name used for the bitmap
      in the VCL palette.  This has to be the uppercase full classname.  It
      is contained in a file named ZIPMSTR.DCR (same name as this file, but
      a different extension), and is automatically included by Delphi during
      compilation/linking. }
    MyBitmap := SelectObject (bmpDC, LoadBitmap (HInstance, 'TZIPMASTER'));
    BitBlt (PS.HDC, 2, 2, 24, 24, bmpDC, 0, 0, SRCCOPY);
    DeleteObject (SelectObject (bmpDC, MyBitmap));
    DeleteObject (bmpDC);

    { cleanup these drawing objects }
    DeleteObject (SelectObject (PS.HDC, MyBrush));
    DeleteObject (SelectObject (PS.HDC, MyPen));
  end;
  EndPaint (Handle, PS);
end;

function TZipMaster.GetMajZipVers: ShortInt;
var
   FMajZipVers: Word;
   FMinZipVers: Word;
begin
   try
      GetDLLVersion(@FMajZipVers, @FMinZipVers);
   except
      ShowMessage('Error talking to ZIPDLL.DLL');
   end;
   result:= ShortInt(FMajZipVers);
end;

function TZipMaster.GetMinZipVers: ShortInt;
var
   FMajZipVers: Word;
   FMinZipVers: Word;
begin
   try
      GetDLLVersion(@FMajZipVers, @FMinZipVers);
   except
      ShowMessage('Error talking to ZIPDLL.DLL');
   end;
   result:= ShortInt(FMinZipVers);
end;

function TZipMaster.GetMajUnzVers: ShortInt;
var
   FMajUnzVers: Word;
   FMinUnzVers: Word;
begin
   try
      { notice the trailing U on function name below }
      GetDLLVersionU(@FMajUnzVers, @FMinUnzVers);
   except
      ShowMessage('Error talking to UNZDLL.DLL');
   end;
   result := ShortInt(FMajUnzVers);
end;

function TZipMaster.GetMinUnzVers: ShortInt;
var
   FMajUnzVers: Word;
   FMinUnzVers: Word;
begin
   try
      { notice the trailing U on function name below }
      GetDLLVersionU(@FMajUnzVers, @FMinUnzVers);
   except
      ShowMessage('Error talking to UNZDLL.DLL');
   end;
   result := ShortInt(FMinUnzVers);
end;

{ We'll normally have a TStringList value, since TStrings itself is an
  abstract class. }
procedure TZipMaster.SetFSpecArgs(Value : TStrings);
begin
   FFSpecArgs.Assign(Value);
end;

procedure TZipMaster.SetFileName(Value : String);
begin
   FZipFileName := Value;
   if not (csDesigning in ComponentState) then
      List; { automatically build a new TLIST of contents in "ZipContents" }
end;

function TZipMaster.GetCount:Integer;
begin
   if FZipFileName <> '' then
      Result:=FZipContents.Count
   else
      Result:=0;
end;

{ Empty FZipContents and free the storage used for dir entries }
procedure TZipMaster.FreeZipDirEntryRecords;
var
   i: integer;
begin
   if FZipContents.Count = 0 then
      Exit;
   for i:=FZipContents.Count-1 downto 0 do
   begin
      if Assigned(FZipContents[i]) then
         // dispose of the memory pointed-to by this entry
         Dispose(PZipDirEntry(FZipContents[i]));
      FZipContents.Delete(i); // delete the TList pointer itself
   end; { end for }
   // The caller will free the FZipContents TList itself, if needed
end;

{ The Delphi code used in the List method is based on the TZReader VCL by
  Dennis Passmore (Compuserve: 71640,2464).  This "list" code is also used
  in the ZIPDIR VCL used by Demo3. TZReader was inspired by Pier Carlo Chiodi
  [e-mail]
}
{ The List method reads thru all entries in the local Zip directory.
  This is triggered by an assignment to the ZipFileName, or by calling
  this method directly. }
procedure TZipMaster.List;  { all work is local - no DLL calls }
var
  Sig: Longint;
  ZipStream: TFileStream;
  Res: Longint;
  ZipDirEntry: PZipDirEntry;
  Name: array [0..255] of char;
begin
  if (csDesigning in ComponentState) then
     Exit;  { can't do LIST at design time }

  { zero out any previous entries }
  FreeZipDirEntryRecords;

  if not FileExists(FZipFileName) then
     Exit; { don't complain - this may intentionally be a new zip file }

  ZipStream := TFileStream.Create(FZipFileName,fmOpenRead);
  try
     while TRUE do
     begin
        Res := ZipStream.Read(Sig, SizeOf(Sig));
        if (Res = HFILE_ERROR) or (Res <> SizeOf(Sig)) then
           raise EStreamError.create('Error 1 reading Zip File');

        if Sig = LocalFileHeaderSig then
        begin
           {===============================================================}
           { This is what we want.  We'll read the local file header info. }

           { Create a new ZipDirEntry record, and zero fill it }
           new(ZipDirEntry);
           fillchar(ZipDirEntry^, sizeof(ZipDirEntry^), 0);

           { fill the ZipDirEntry struct with local header info for one entry. }
           { Note: In the "if" statement's first clause we're reading the info
             for a whole Zip dir entry, not just the version info. }
           with ZipDirEntry^ do
           if (ZipStream.Read(Version, LocalDirEntrySize) = LocalDirEntrySize)
           and (ZipStream.Read(Name, FileNameLength)=FileNameLength) then
              FileName := Copy(Name, 0, FileNameLength)
           else
           begin
              dispose(ZipDirEntry);  { bad entry - free up memory for it }
              raise EStreamError.create('Error 2 reading Zip file');
           end;
           FZipContents.Add(pointer(ZipDirEntry));

           if (ZipStream.Position + ZipDirEntry^.ExtraFieldLength +
            ZipDirEntry^.CompressedSize) > (ZipStream.Size - 22) then
           begin
              { should never happen due to presence of central dir }
              raise EStreamError.create('Error 3 reading Zip file');
              break;
           end;

           with ZipDirEntry^ do
           begin
              if ExtraFieldLength > 0 then
              begin
                 { skip over the extra fields }
                 res := (ZipStream.Position + ExtraFieldLength);
                 if ZipStream.Seek(ExtraFieldLength, soFromCurrent) <> res then
                    raise EStreamError.create('Error 4 reading Zip file');
              end;

              { skip over the compressed data for the file entry just parsed }
              res := (ZipStream.Position + CompressedSize);
              if ZipStream.Seek(CompressedSize, soFromCurrent) <> res then
                 raise EStreamError.create('Error 5 reading Zip file');
           end;
           {===============================================================}
        end  { end of local stuff }

        else
           { we're not going to read the Central or End directories }
           if (Sig = CentralFileHeaderSig) or (Sig = EndCentralDirSig) then
              break;   { found end of local stuff - we're done }
     end;  { end of loop }

  finally
     ZipStream.Free;
  end;  { end of try...finally }

  { let user's program know we just refreshed the zip dir contents }
  if assigned (FOnDirUpdate) then
     FOnDirUpdate(self);
end;

procedure TZipMaster.SetZipSwitches;
begin
   with ZipParms1 do
   begin
      Version:=100;    // version we expect the DLL to be
      Caller := Self;  // point to our instance
      ZipParms1.Handle:=Parent.Handle;
      ZCallbackFunc:=ZCallback; // pass addr of function to be called from DLL

      fEncryptVerify:=False; { not supported }
      fEncrypt:=False;       { not supported }

      fQuiet:=True;   { we'll report errors upon notification in our callback }
      fJunkSFX:=False;      { if True, convert input .EXE file to .ZIP }
      fLatestTime:=False;   { if True, make zipfile's timestamp same as newest file }
      fComprSpecial:=False; { if True, try to compr already compressed files }
      fSystem:=False;    { if True, include system and hidden files }
      fVolume:=False;    { if True, include volume label from root dir }
      fExtra:=False;     { if True, include extended file attributes }

      { fDate and Date are not yet supported }
      fDate:=False;      { if True, exclude files earlier than specified date }
      { Date:= '100592'; } { Date to include files after; only used if fDate=TRUE }

      fLevel:=9;       { Compression level (0 - 9, 0=none and 9=best) }
      fCRLF_LF:=False; { if True, translate text file CRLF to LF (if dest is Unix) }
      fForce:=False;  { if True, convert all filenames to 8x3 format }
      fGrow := True;  { if True, Allow appending to a zip file (-g)}

      seven:=7;       { used to QC the data structure passed to DLL }
      fDeleteEntries:=False; { distinguish bet. Add and Delete }

      if fTrace then
         fTraceEnabled:=True
      else
         fTraceEnabled:=False;
      if fVerbose then
         fVerboseEnabled:=True
      else
         fVerboseEnabled:=False;
      if (fTraceEnabled and not fVerbose) then
         fVerboseEnabled:=True;  { if tracing, we want verbose also }

      if Move in fAddOptions then
         fMove:=True      { dangerous, beware! }
      else
         fMove:=False;

      if AddFreshen in fAddOptions then
         fFreshen:=True
      else
         fFreshen:=False;
      if AddUpdate in fAddOptions then
         fUpdate:=True
      else
         fUpdate:=False;
      if fFreshen and fUpdate then
         fFreshen:=False;  { Update has precedence over freshen }

      { NOTE: if user wants recursion, then he probably also wants
        AddDirNames, but we won't demand it. }
      if RecurseDirs in fAddOptions then
         fRecurse:=True
      else
         fRecurse:=False;

      if AddDirNames in fAddOptions then
      begin
         fNoDirEntries:=False;  { we want dirnames by themselves }
         fJunkDir:=False;       { we also want dirnames with filenames }
      end
      else
      begin
         fNoDirEntries:=True;  { don't store dirnames by themselves }
         fJunkDir:=True;       { don't store dirnames with filenames }
      end;
   end; { end with }
end;

procedure TZipMaster.SetUnZipSwitches;
begin
   with UnZipParms1 do
   begin
      Version:=100;    // version we expect the DLL to be
      Caller := Self;  // set our instance
      ZipParms1.Handle:=Parent.Handle; // pass our parent form's window handle
      ZCallbackFunc:=ZCallback; // pass addr of function to be called from DLL

      if fTrace then
         fTraceEnabled:=True
      else
         fTraceEnabled:=False;
      if fVerbose then
         fVerboseEnabled:=True
      else
         fVerboseEnabled:=False;
      if (fTraceEnabled and not fVerboseEnabled) then
         fVerboseEnabled:=True;  { if tracing, we want verbose also }

      fQuiet:=True;     { no DLL error reporting }
      fDecrypt:=False;  { decryption - not supported }
      fComments:=False; { zipfile comments - not supported }
      fConvert:=False;  { ascii/EBCDIC conversion - not supported }
      fTest:=False;     { test zipfile - not supported }
      seven:=7;         { used to QC the data structure passed to DLL }

      if ExtrDirNames in ExtrOptions then
         fDirectories:=True
      else
         fDirectories:=False;
      if OverWrite in fExtrOptions then
         fOverwrite:=True
      else
         fOverwrite:=False;

      if ExtrFreshen in fExtrOptions then
         fFreshen:=True
      else
         fFreshen:=False;
      if ExtrUpdate in fExtrOptions then
         fUpdate:=True
      else
         fUpdate:=False;
      if fFreshen and fUpdate then
         fFreshen:=False;  { Update has precedence over freshen }
   end; { end with }
end;

procedure TZipMaster.Add;
var
  i: Integer;
begin
  if fFSpecArgs.Count = 0 then
  begin
     ShowMessage('Error - no files to zip');
     Exit;
  end;
  if FZipBusy then
     Exit;
  { We must allow a zipfile to be specified that doesn't already exist,
    so don't check here for existance. }
  if FZipFileName = '' then   { make sure we have a zip filename }
  begin
     ShowMessage('Error - no zip file specified');
     Exit;
  end;

  { Make sure we can't get back in here while work is going on }
  FZipBusy := True;
  FCancel := False;

  SetZipSwitches;
  with ZipParms1 do
  begin
      PZipFN := StrAlloc(256);  { allocate room for null terminated string }
      StrPCopy(PZipFN, fZipFileName);   { name of zip file }
      argc:=0;  { init to zero }

      { Copy filenames from the Stringlist to new var's we will alloc
        storage for.  This lets us append the null needed by the DLL. }
      for i := 0 to fFSpecArgs.Count - 1 do
      begin
         PFileNames[argc]:=StrAlloc(256);  { alloc room for the filespec }
         StrPCopy(PFileNames[argc], fFSpecArgs[i]);  { file to add to archive }
         argc:=argc+1;
      end;
      { argc is now the no. of filespecs we want added/deleted }
   end;  { end with }

   Cursor:=crHourGlass;
   try
      { pass in a ptr to parms }
      fSuccessCnt:=Integer(DllZipUpFiles(@ZipParms1));
   except
      ShowMessage('Fatal DLL Error: abort exception');
   end;
   Cursor:=crDefault;

   fFSpecArgs.Clear;
   { Free the memory for the zipfilename and parameters }
   with ZipParms1 do
   begin
      { we know we had a filename, so we'll dispose it's space }
      StrDispose(PZipFN);
      { loop thru each parameter filename and dispose it's space }
      for i := 0 to argc - 1 do
         StrDispose(PFileNames[i]);
   end;
   FCancel := False;
   FZipBusy := False;
   if fSuccessCnt > 0 then
      List;  { Update the Zip Directory by calling List method }
end;

procedure TZipMaster.Delete;
var
  i: Integer;
begin
  if fFSpecArgs.Count = 0 then
  begin
     ShowMessage('Error - no files selected for deletion');
     Exit;
  end;
  if not FileExists(FZipFileName) then
  begin
     ShowMessage('Error - no zip file specified');
     Exit;
  end;
  if FZipBusy then
     Exit;
  FZipBusy:= True;  { delete uses the ZIPDLL, so it shares the ZipBusy flag }

  SetZipSwitches;
  { override "add" behavior assumed by SetZipSwitches }
  ZipParms1.fDeleteEntries:=True;
  ZipParms1.fGrow:=False;
  ZipParms1.fNoDirEntries:=False;
  ZipParms1.fJunkDir:=False;

  with ZipParms1 do
  begin
      PZipFN := StrAlloc(256);  { allocate room for null terminated string }
      StrPCopy(PZipFN, fZipFileName);  { name of zip file }
      argc:=0;

      { Copy filenames from the Stringlist to new var's we will alloc
        storage for.  This lets us append the null needed by the DLL. }
      for i := 0 to fFSpecArgs.Count - 1 do
      begin
         PFileNames[argc]:=StrAlloc(256);  { alloc room for the filespec }
         { ShowMessage(fFSpecArgs[i]); } { for debugging }
         StrPCopy(PFileNames[argc], fFSpecArgs[i]); { file to del from archive }
         argc:=argc+1;
      end;
      { argc is now the no. of filespecs we want deleted }
   end;  { end with }

   Cursor:=crHourGlass;
   try
      { pass in a ptr to parms }
      fSuccessCnt:=Integer(DllZipUpFiles(@ZipParms1));
   except
      ShowMessage('Fatal DLL Error: abort exception');
   end;
   Cursor:=crDefault;

   fFSpecArgs.Clear;
   { Free the memory }
   with ZipParms1 do
   begin
      StrDispose(PZipFN);
      for i := 0 to argc - 1 do
         StrDispose(PFileNames[i]);
   end;
   FZipBusy:=False;
   if fSuccessCnt > 0 then
      List;  { Update the Zip Directory by calling List method }
end;

procedure TZipMaster.Extract;
var
  i: Integer;
begin
  if FUnzBusy then
     Exit;
  { Make sure we can't get back in here while work is going on }
  FUnzBusy := True;
  FCancel := False;

  { Select the extract directory }
  if DirectoryExists(fExtrBaseDir) then
     SetCurrentDir(fExtrBaseDir);

  SetUnzipSwitches;

  with UnzipParms1 do
  begin
      PZipFN := StrAlloc(256);  { allocate room for null terminated string }
      StrPCopy(PZipFN, fZipFileName);   { name of zip file }
      argc:=0;

      { Copy filenames from the Stringlist to new var's we will alloc
        storage for.  This lets us append the null needed by the DLL. }
      for i := 0 to fFSpecArgs.Count - 1 do
      begin
         PFileNames[argc]:=StrAlloc(256);  { alloc room for the filespec }
         { ShowMessage(fFSpecArgs[i]); } { for debugging }
         StrPCopy(PFileNames[argc], fFSpecArgs[i]); { file to extr from archive }
         argc:=argc+1;
      end;
      { argc is now the no. of filespecs we want extracted }
   end;  { end with }

   Cursor:=crHourGlass;
   try
      { pass in a ptr to parms }
      fSuccessCnt:=Integer(DLLProcessZipFiles(@UnZipParms1));
   except
      ShowMessage('Fatal DLL Error: abort exception');
   end;
   Cursor:=crDefault;

   fFSpecArgs.Clear;
   { Free the memory }
   with UnZipParms1 do
   begin
      StrDispose(PZipFN);
      for i := 0 to argc - 1 do
         StrDispose(PFileNames[i]);
   end;
   fFSpecArgs.Clear;
   FCancel := False;
   FUnzBusy := False;
   { no need to call the List method; contents unchanged }
end;

function TZipMaster.AppendSlash(const sDir : String): String;
begin
  Result := sDir;
  if (Length(sDir)>0) and (sDir[Length(sDir)]<>'\') then
     Result := Result+'\';
end;

{ returns 0 if good copy, or a negative error code }
function TZipMaster.CopyFile(const src, dest: String): Integer;
Const
   SE_CreateError   = -1;  { error in open of outfile }
   SE_CopyError     = -2;  { read or write error during copy }
   SE_OpenReadError = -3;  { error in open of infile }
   SE_SetDateError  = -4;  { error setting date/time of outfile }
Var
   S,T: TFileStream;
Begin
   Result := 0;
   try
      S := TFileStream.Create( src, fmOpenRead );
   except
      Result:=SE_OpenReadError;
      exit;
   end;

   try
      T := TFileStream.Create( dest, fmOpenWrite or fmCreate );
   except
      Result := SE_CreateError;
      S.Free;  { S was already made - free it }
      exit;
   end;

   try
      T.CopyFrom(S, S.Size ) ;
   except
      Result := SE_CopyError;
      S.Free;
      T.Free;
      exit;
   end;

   try
      FileSetDate(T.Handle, FileGetDate( S.Handle ));
   except
      Result := SE_SetDateError;
   end;

   S.Free;
   T.Free;
End;

procedure Register;
begin
  RegisterComponents('Samples', [TZipMaster]);
end;

end.