Chip 1998 March/Chip_1998-03_cd.bin/zkuste/delphi/komprese/zip/DELZIP12.ZIP/DEMO1.ZIP/MAINUNIT.PAS

Pascal/Delphi Source File | 1997-09-28 | 13KB | 434 lines

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ExtCtrls, SortGrid, ZipMstr;

type
  TMainform = class(TForm)
    Panel2: TPanel;
    StringGrid1: TSortGrid;
    OpenDialog1: TOpenDialog;
    ZipMaster1: TZipMaster;
    Panel1: TPanel;
    CloseBut: TButton;
    Label1: TLabel;
    FilesLabel: TLabel;
    Bevel2: TBevel;
    Panel3: TPanel;
    DeleteZipBut: TButton;
    NewZipBut: TButton;
    ZipOpenBut: TButton;
    Panel4: TPanel;
    ZipFName: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    DeleteBut: TButton;
    AddBut: TButton;
    ExtractBut: TButton;
    procedure ZipOpenButClick(Sender: TObject);
    procedure CloseButClick(Sender: TObject);
    procedure NewZipButClick(Sender: TObject);
    procedure DeleteZipButClick(Sender: TObject);
    procedure ExtractButClick(Sender: TObject);
    procedure ZipMaster1DirUpdate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FillGrid;
    procedure AddButClick(Sender: TObject);
    procedure ZipMaster1Message(Sender: TObject; ErrCode: Integer;
      Message: string);
    procedure ZipMaster1Progress(Sender: TObject; ProgrType: ProgressType;
      FileName: string; FileSize: Longint);
    procedure DeleteButClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Mainform: TMainform;
  ExtractDir: String;
  ExpandDirs: Boolean;
  OverWr: Boolean;
  AllFiles: Boolean;
  Canceled: Boolean;

implementation

uses extrunit, msgunit, addunit;

{$R *.DFM}

procedure TMainform.CloseButClick(Sender: TObject);
begin
   Close;
end;

procedure TMainform.ZipOpenButClick(Sender: TObject);
begin
   with OpenDialog1 do
   begin
      Title:='Open Existing ZIP File';
      Options:=Options+[ofHideReadOnly,ofShareAware,ofPathMustExist,ofFileMustExist];
      Filter :='ZIP Files (*.ZIP, *.EXE)|*.zip;*.exe';
      if Execute then
      begin
         try
            { assigning the filename will cause the table of contents to be read }
            Screen.Cursor := crHourglass;
            ZipMaster1.ZipFileName:=FileName;
         finally
            Screen.Cursor := crDefault;
            { Set the caption after assigning the filename. This
              way, the filename will be null if the open failed. }
            ZipFName.Caption:=ZipMaster1.ZipFileName;
         end;
      end;
   end;
end;

procedure TMainform.NewZipButClick(Sender: TObject);
var
   ans:Boolean;
begin
   with OpenDialog1 do
   begin
      Title:='Create New ZIP File';
      Options:=Options+[ofHideReadOnly,ofShareAware];
      Options:=Options-[ofPathMustExist,ofFileMustExist];
      Filter :='ZIP Files (*.ZIP)|*.zip';
      if Execute then
      begin
        if Pos('.zip', lowercase(Filename)) = 0 then
           FileName:=FileName+'.zip';
        if FileExists(FileName) then
        begin
           Ans:=MessageDlg('Overwrite Existing File: ' + FileName + '?',
                          mtConfirmation,[mbYes,mbNo],0)=mrYes;
           if Ans then
              DeleteFile(FileName)
           else
              Exit;  { Don't use the new name }
        end;
        ZipFName.Caption:=Filename;
        ZipMaster1.ZipFileName:=FileName; { updates the zip dir }
      end;
   end; { end with }
end;

procedure TMainform.DeleteZipButClick(Sender: TObject);
var
   ans:Boolean;
begin
   if FileExists(ZipFName.Caption) then
   begin
      Ans:=MessageDlg('Are you sure you want to delete: ' + ZipFName.Caption
            + '?', mtConfirmation,[mbYes,mbNo],0)=mrYes;
      if Ans then
      begin
         DeleteFile(ZipFName.Caption);
         ZipFName.Caption:='<none>';
         StringGrid1.RowCount:=1; { empty }
      end
      else
         Exit;  { Don't use the new name }
   end
   else
      ShowMessage('Zip file not found: ' + ZipFName.Caption);
end;

procedure TMainform.ExtractButClick(Sender: TObject);
var
   i: Integer;
begin
   if not FileExists(ZipFName.Caption) then
   begin
      ShowMessage('Error: file not found: ' + ZipFName.Caption);
      Exit;
   end;
   Extract.ShowModal;
   if (ExtractDir = '') or Canceled then
      Exit;

   with StringGrid1 do
   begin
      if (RowCount - 1) < 1 then
      begin
         ShowMessage('Error - no files to extract');
         Exit;
      end;
      ZipMaster1.FSpecArgs.Clear;
      { Get fspecs of selected files, unless user wants all files extracted }
      if not AllFiles then
      begin
         for i := Selection.Top to Selection.Bottom do
         begin
            ZipMaster1.FSpecArgs.Add(Cells[0,i]);
          { ShowMessage('Selecting ' + Cells[0,i]); } { for debugging }
         end; { end for }
         if ZipMaster1.FSpecArgs.Count < 1 then
         begin
            ShowMessage('Error - no files selected');
            Exit;
         end;
      end;
   end; { end with }

   MsgForm.Memo1.Clear;
   MsgForm.Show;
   { Put this message into the message form's memo }
   ZipMaster1Message(self,0,'Beginning Extract from ' + ZipMaster1.ZipFileName);

   with ZipMaster1 do
   begin
      ExtrBaseDir:=ExtractDir;
      Verbose:=True;
      Trace:=False;
      ExtrOptions:=[];
      if ExpandDirs then
         ExtrOptions:=ExtrOptions+[ExtrDirNames];
      if Overwr then
         ExtrOptions:=ExtrOptions+[ExtrOverwrite];
      try
         Extract;
      except
         ShowMessage('Error in Extract; Fatal DLL Exception in mainunit');
      end;
      ShowMessage(IntToStr(SuccessCnt)+' files were extracted');
   end; { end with }
end;

procedure TMainform.ZipMaster1DirUpdate(Sender: TObject);
begin
   FillGrid;
   FilesLabel.Caption:=IntToStr(ZipMaster1.Count);
end;

procedure TMainform.FormCreate(Sender: TObject);
begin
  with StringGrid1 do
  begin
    { Make sure "goColMoving" is false in object inspector. This lets the
      TSortGrid use Mouse Clicks on the col headers. }
    FixedRows:=0;
    RowCount:=1;  { first row is fixed, and used for column headers }
    ColCount:=4;
    Cells[0,0] := 'File Name       (Click on a column header to sort)';
    Cells[1,0] := 'Compr Size';
    Cells[2,0] := 'Uncmpr Size';
    Cells[3,0] := 'Date/Time';
    ColWidths[0]:=316;
    ColWidths[1]:=84;
    ColWidths[2]:=84;
    ColWidths[3]:=120;
  end;
  ZipMaster1.Load_Zip_Dll;
  ZipMaster1.Load_Unz_Dll;
end;

procedure TMainForm.FillGrid;
var
  i: Integer;
begin
  with StringGrid1 do
  begin
    { Empty data from string grid }
    FixedRows:=0;
    RowCount:=1; { remove everything from grid except col titles }
    if ZipMaster1.Count = 0 then
       Exit;

    for i:=0 to ZipMaster1.Count-1 do
    begin
       RowCount := RowCount + 1;
       { We have to set fixed rows after the rowcount is more than 1}
       FixedRows:=1;
       with ZipDirEntry(ZipMaster1.ZipContents[i]^) do
       begin
          { The "-1" below is an offset for the row titles }
          Cells[0,RowCount-1] := FileName;
          Cells[1,RowCount-1] := IntToStr(CompressedSize);
          Cells[2,RowCount-1] := IntToStr(UncompressedSize);
          Cells[3,RowCount-1] := FormatDateTime('ddddd  t',FileDateToDateTime(DateTime));
       end; // end with
    end; // end for
  end; // end with
end;

procedure TMainform.AddButClick(Sender: TObject);
begin
   if ZipMaster1.ZipFileName = '' then
   begin
      ShowMessage('Error - open a zip file first');
      Exit;
   end;
   if LowerCase(Copy(ZipMaster1.ZipFileName,Length(ZipMaster1.ZipFileName)-3,4)) = '.exe' then
   begin
     ShowMessage('Error - this pgm can NOT add files to a self-extracting archive');
     // actually it can, but the resulting CRC value for the overall file
     // will be wrong, so I've disabled it
     Exit;
   end;
   AddForm.Left:=Left;
   AddForm.Top:=Top;
   AddForm.Width:=Width;
   AddForm.Height:=Height;
   Canceled:=False;
   AddForm.ShowModal;  { let user pick filenames to add }
   if Canceled then
      Exit;
   if AddForm.SelectedList.Items.Count = 0 then
   begin
      ShowMessage('No files selected');
      Exit;
   end;
   MsgForm.Memo1.Clear;
   MsgForm.Show;
   { Put this message into the message form's memo }
   ZipMaster1Message(self,0,'Beginning Add to ' + ZipMaster1.ZipFileName);

   with ZipMaster1 do
   begin
      { We want any DLL error messages to show over the top
        of the message form. }
      Verbose:=True;
      Trace:=False;
      AddOptions:=[];
      if AddForm.RecurseCB.Checked then
         AddOptions:=AddOptions+[AddRecurseDirs];  { we want recursion }
      if AddForm.DirnameCB.Checked then
         AddOptions:=AddOptions+[AddDirNames];  { we want dirnames }
      FSpecArgs.Clear;
      FSpecArgs.Assign(AddForm.SelectedList.Items); { specify filenames }
      AddForm.SelectedList.Clear;
      try
         Add;
      except
         ShowMessage('Error in Add; Fatal DLL Exception in mainunit');
      end;
      ShowMessage(IntToStr(SuccessCnt)+' files were added');
   end; { end with }
end;

procedure TMainform.ZipMaster1Message(Sender: TObject; ErrCode: Integer;
  Message: string);
begin
   MsgForm.Memo1.Lines.Add(Message);
   if ErrCode > 0 then
      ShowMessage('Error Msg from DLL: ' + Message);
end;

procedure TMainform.ZipMaster1Progress(Sender: TObject;
  ProgrType: ProgressType; FileName: string; FileSize: Longint);
begin
   if ProgrType = NewFile then
   begin
      {ShowMessage('in OnProgress type 1, size= ' + IntToStr(FileSize));}
      MsgForm.FileBeingZipped.Caption:=FileName;
      with MsgForm.ProgressBar1 do
      begin
         min:=1;    { first step }
         max:=10;   { reasonable value for now ... }
         step:=1;   { no. of steps for each "StepIt" }
         position:=min; { current position of bar }

         { Max is assigned the approximate # of callbacks }
         if (FileSize div 32768) > 1 then
            Max := FileSize div 32768  { total no of steps }
         else
            Max := 1;
         if (FileSize < 32768) then
            StepIt;   { max out progress for small files }
      end;
   end;

   if ProgrType = ProgressUpdate then
   begin
      {ShowMessage('in OnProgress type 2'); }
      with MsgForm.ProgressBar1 do
         if position < Max then
            StepIt;
   end;

   if ProgrType = EndOfBatch then
   begin
      { reset the progress bar and filename }
      {ShowMessage('In OnProgress type 3');}
      MsgForm.FileBeingZipped.Caption:='';
      with MsgForm.ProgressBar1 do
      begin
         min:=1;
         max:=10;
         step:=1;
         position:=min;
      end;
   end;
   Application.ProcessMessages;
end;

procedure TMainform.DeleteButClick(Sender: TObject);
var
   i: Integer;
   Ans: Boolean;
begin
   if LowerCase(Copy(ZipMaster1.ZipFileName,Length(ZipMaster1.ZipFileName)-3,4)) = '.exe' then
   begin
      ShowMessage('Error - this pgm can NOT delete files from a self-extracting archive');
      // actually it can, but it will corrupt a winzip .exe, so I've disabled it
      Exit;
   end;

   with StringGrid1 do
   begin
      if (RowCount - 1) < 1 then
      begin
         ShowMessage('Error - no files to delete');
         Exit;
      end;
      Ans:=MessageDlg('Delete selected files from: '
        + ZipMaster1.ZipFileName + '?',
                   mtConfirmation,[mbYes,mbNo],0)=mrYes;
      if not Ans then
         Exit;

      ZipMaster1.FSpecArgs.Clear;
      for i := Selection.Top to Selection.Bottom do
      begin
         ZipMaster1.FSpecArgs.Add(Cells[0,i]);
        { ShowMessage('Selecting ' + Cells[0,i]); for debugging }
      end; { end for }

      if ZipMaster1.FSpecArgs.Count < 1 then
      begin
         ShowMessage('Error - no files selected');
         Exit;
      end;
   end; { end with }

   MsgForm.Memo1.Clear;
   MsgForm.Show;
   { Put this message into the message form's memo }
   ZipMaster1Message(self,0,'Beginning delete from ' + ZipMaster1.ZipFileName);

   ZipMaster1.Verbose:=True;
   ZipMaster1.Trace:=False;
   try
      ZipMaster1.Delete;
   except
      ShowMessage('Fatal error trying to delete');
   end;
   ShowMessage(IntToStr(ZipMaster1.SuccessCnt)+' files were Deleted');
end;

procedure TMainform.FormDestroy(Sender: TObject);
begin
  ZipMaster1.Unload_Zip_Dll;
  ZipMaster1.Unload_Unz_Dll;
end;

end.