Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit Main;
  2. (************************************************************************
  3.  Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  4.       Eric W. Engler and Chris Vleghert.
  5.  
  6.    This file is part of TZipMaster Version 1.9.
  7.  
  8.     TZipMaster is free software: you can redistribute it and/or modify
  9.     it under the terms of the GNU Lesser General Public License as published by
  10.     the Free Software Foundation, either version 3 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     TZipMaster is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU Lesser General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU Lesser General Public License
  19.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  20.  
  21.     contact: problems@delphizip.org (include ZipMaster in the subject).
  22.     updates: http://www.delphizip.org
  23.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  24. ************************************************************************)
  25.  
  26.  
  27. {$INCLUDE '..\..\ZipVers19.inc'}
  28. {$IFDEF VERD6up}
  29. {$WARN UNIT_PLATFORM OFF}
  30. {$WARN SYMBOL_PLATFORM OFF}
  31. {$ENDIF}
  32.  
  33.  
  34. interface
  35.  
  36. uses
  37.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  38.   ZipMstr19, Menus, Grids, SortGrid, StdCtrls, ExtCtrls, ShlObj, FileCtrl, ImgList
  39.   ;
  40.  
  41. //{$IfNDef VERD4+}  // if not Delphi v4+
  42. //type
  43. //   Int64 = Comp;  // 64 bit integers are supported differently by Delphi 2 and 3
  44. //{$EndIf}
  45.  
  46. type
  47.   TMainForm = class( TForm )
  48.     Panel2:          TPanel;
  49.     Panel3:          TPanel;
  50.     Panel4:          TPanel;
  51.     Label1:          TLabel;
  52.     Label2:          TLabel;
  53.     Label4:          TLabel;
  54.     Label5:          TLabel;
  55.     Label6:          TLabel;
  56.     ZipFName:        TLabel;
  57.     FilesLabel:      TLabel;
  58.     MaxVolSizeEdit:  TEdit;
  59.     FreeDisk1Edit:   TEdit;
  60.     MinFreeVolEdit:  TEdit;
  61.     WipeCB: TCheckBox;
  62.     Bevel1:          TBevel;
  63.     AddBut:          TButton;
  64.     ExtractBut:      TButton;
  65.     WriteBttn:       TButton;
  66.     ReadBttn:        TButton;
  67.     NewZipBut:       TButton;
  68. //    StringGrid1:     TSortGrid;
  69.     OpenDialog1:     TOpenDialog;
  70.     ImageList1:      TImageList;
  71.     MainMenu1:       TMainMenu;
  72.     File1:           TMenuItem;
  73.     Exit1:           TMenuItem;
  74.     Project1:        TMenuItem;
  75.     Showlasterror1:  TMenuItem;
  76.     DLLversioninfo1: TMenuItem;
  77.     Messages1:       TMenuItem;
  78.     ZipMaster1: TZipMaster19;
  79.  
  80.     procedure StringGrid1BeginSort( Sender: TObject; Col: LongInt; var SortOptions: TSortOptions );
  81.     procedure StringGrid1ClickSort( Sender: TObject; Col, Row: LongInt; var SortOptions: TSortOptions );
  82.     procedure StringGrid1DrawCell( Sender: TObject; Col, Row: LongInt; Rect: TRect; State: TGridDrawState );
  83.     procedure StringGrid1EndSort( Sender: TObject; Col: LongInt );
  84.     procedure StringGrid1GetCellFormat( Sender: TObject; Col, Row: LongInt; State: TGridDrawState; var FormatOptions: TFormatOptions );
  85.     procedure NewZipButClick( Sender: TObject );
  86.     procedure AddButClick( Sender: TObject );
  87.     procedure WriteBttnClick( Sender: TObject );
  88.     procedure ExtractButClick( Sender: TObject );
  89.     procedure ReadBttnClick( Sender: TObject );
  90.     procedure Exit1Click( Sender: TObject );
  91.     procedure Showlasterror1Click( Sender: TObject );
  92.     procedure DLLversioninfo1Click( Sender: TObject );
  93.     procedure Messages1Click( Sender: TObject );
  94.     procedure FreeDisk1EditChange( Sender: TObject );
  95.     procedure MinFreeVolEditChange( Sender: TObject );
  96.     procedure MaxVolSizeEditChange( Sender: TObject );
  97.     procedure ZipMaster1Message( Sender: TObject; ErrCode: Integer; Message: String );
  98. // TODO: ZipMaster1Progress
  99. //  procedure ZipMaster1Progress( Sender: TObject; ProgrType: ProgressType; Filename: String; FileSize: Int64);//Integer );
  100.     procedure ZipMaster1DirUpdate( Sender: TObject );
  101.     procedure FormCreate( Sender: TObject );
  102.     procedure FormDestroy( Sender: TObject );
  103.     procedure FormResize(Sender: TObject);
  104.     procedure ZipMaster1Progress(Sender: TObject; details: TZMProgressDetails);
  105.  
  106.   public    { Public declarations }
  107.      FirstDir1, FirstDir2: String;
  108.      FirstDir3, FirstDir4: String;
  109.      FirstDir5:            String;      
  110.     StringGrid1:     TSortGrid;
  111.      GSortOptions:         TSortOptions;
  112.      TotUncomp, TotComp:   Cardinal;
  113. //     TotalSize1, TotalProgress1, TotalSize2, TotalProgress2: Int64;
  114.      DoIt:                 Boolean;
  115.      GSortCol:             LongInt;
  116.  
  117.      procedure AddSpan;
  118.      procedure FillGrid;
  119.      procedure SetZipTotals;
  120.      procedure SetZipFName( aCaption: String; AssignName: Boolean );
  121.      function  ZipOpenArchive: Boolean;
  122.      function  AskDirDialog( const FormHandle: HWND; var DirPath: String ): Boolean;
  123.      function  GetSpecialFolder( aFolder: Integer; var Location: String ): LongWord;
  124.   end;
  125.  
  126. var
  127.   MainForm:   TMainForm;
  128.   ExtractDir: String;
  129.   ExpandDirs, OverWr, AllFiles, Canceled: Boolean;
  130.  
  131. implementation
  132.  
  133. uses MsgUnit, ExtrUnit, AddUnit, printers;
  134.  
  135. {$R *.DFM}
  136.  
  137. procedure TMainForm.FormCreate( Sender: TObject );
  138. begin
  139.   StringGrid1 := TSortGrid.Create(self);
  140.   StringGrid1.Parent := Self;
  141.    { Make sure "goColMoving" is false in object inspector. This lets the
  142.      TSortGrid use Mouse Clicks on the col headers. }
  143.    with StringGrid1 do
  144.    begin
  145.     Left := 0;
  146.     Top := 109;
  147.     Width := 617;
  148.     Height := 283;
  149.     Align := alClient;
  150.     ColCount := 6;
  151.     DefaultRowHeight := 22;
  152.     FixedCols := 0;
  153.     RowCount := 8;
  154.     Font.Charset := DEFAULT_CHARSET;
  155.     Font.Color := clWindowText;
  156.     Font.Height := -12;
  157.     Font.Name := 'Arial';
  158.     Font.Style := [];
  159.     Options := [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goColSizing, goRowSelect];
  160.     ParentFont := False;
  161.     TabOrder := 1;
  162.     OnDrawCell := StringGrid1DrawCell;
  163.     CaseSensitive := False;
  164.     AlignmentHorz := taLeftJustify;
  165.     AlignmentVert := taTopJustify;
  166.     ProportionalScrollBars := True;
  167.     ExtendedKeys := False;
  168.     SortOnClick := True;
  169.     FooterFont.Charset := DEFAULT_CHARSET;
  170.     FooterFont.Color := clWindowText;
  171.     FooterFont.Height := -11;
  172.     FooterFont.Name := 'MS Sans Serif';
  173.     FooterFont.Style := [];
  174.     PrintOptions.Orientation := poPortrait;
  175.     PrintOptions.PageTitleMargin := 0;
  176.     PrintOptions.PageFooter := 'date|time|page';
  177.     PrintOptions.HeaderSize := 10;
  178.     PrintOptions.FooterSize := 7;
  179.     PrintOptions.DateFormat := 'd-mmm-yyyy';
  180.     PrintOptions.TimeFormat := 'h:nn';
  181.     PrintOptions.FromRow := 0;
  182.     PrintOptions.ToRow := 0;
  183.     PrintOptions.BorderStyle := bsNone;
  184.     PrintOptions.MarginBottom := 0;
  185.     PrintOptions.MarginLeft := 0;
  186.     PrintOptions.MarginTop := 0;
  187.     PrintOptions.MarginRight := 0;
  188.     WordWrap := False;
  189.     OnGetCellFormat := StringGrid1GetCellFormat;
  190.     OnClickSort := StringGrid1ClickSort;
  191.     OnBeginSort := StringGrid1BeginSort;
  192.     OnEndSort := StringGrid1EndSort;
  193.     ColWidths[0] := 123;
  194.     ColWidths[1] := 89;
  195.     ColWidths[2] := 100;
  196.     ColWidths[3] := 101;
  197.     ColWidths[4] := 52;
  198.     ColWidths[5] := 143;
  199.       RowCount     := 2;  // First row is fixed, and used for column headers.
  200.       Cells[0, 0]  := 'File Name';
  201.       Cells[1, 0]  := 'Compr. Size';
  202.       Cells[2, 0]  := 'Uncompr. Size';
  203.       Cells[3, 0]  := 'Date Time';
  204.       Cells[4, 0]  := 'Ratio';
  205.       Cells[5, 0]  := 'Path';
  206.    end;
  207.  
  208.    ZipMaster1.DLL_Load := true;
  209. //      Load_Zip_Dll;
  210. //      Load_Unz_Dll;
  211.       { If we had args on the cmd line, then try to open the first one
  212.         as a zip/exe file.  This is most useful in case user has an association
  213.         to ".zip" that causes this program to run when user double clicks on a zip
  214.         file in Explorer. }
  215.    if ParamCount > 0 then
  216.      ZipMaster1.ZipFilename := ParamStr( 1 );
  217.    with GSortOptions do
  218.    begin
  219.       SortDirection     := sdAscending;
  220.       SortStyle         := ssAutomatic;
  221.       SortCaseSensitive := False;
  222.    end;
  223. end;
  224.  
  225. procedure TMainForm.FormDestroy( Sender: TObject );
  226. begin
  227.   ZipMaster1.DLL_Load := false;
  228. //   ZipMaster1.Unload_Zip_Dll;
  229. //   ZipMaster1.Unload_Unz_Dll;
  230. end;
  231.  
  232. procedure TMainForm.FormResize( Sender: TObject );
  233. begin
  234.    if Width - 291 > 0 then
  235.       ZipFName.Width := Width - 291
  236.    else
  237.       ZipFName.Width := 0;
  238.    SetZipFName( ZipMaster1.ZipFilename, False );
  239. end;
  240.  
  241.  
  242. procedure TMainForm.NewZipButClick( Sender: TObject );
  243. var
  244.    Ans: Word;
  245. begin
  246.    if FirstDir1 = '' then
  247.       GetSpecialFolder( CSIDL_DESKTOPDIRECTORY, FirstDir1 );
  248.    with OpenDialog1 do
  249.    begin
  250.       InitialDir := FirstDir1;
  251.       Title      := 'Create New ZIP File';
  252.       FileName   := '';
  253.       Filter     := 'ZIP Files (*.ZIP)|*.zip';
  254.       DefaultExt := 'Zip';
  255.       Options := Options + [ofHideReadOnly, ofShareAware];
  256.       Options := Options - [ofPathMustExist, ofFileMustExist];
  257.       if Execute then
  258.       begin
  259.          FirstDir1 := ExtractFilePath( FileName );
  260.          if UpperCase( ExtractFileExt( FileName ) ) <> '.ZIP' then
  261.          begin
  262.             ShowMessage( 'Error: your new archive must end in .ZIP' );
  263.             Exit;
  264.          end;
  265.          if FileExists( FileName ) then
  266.          begin
  267.             Ans := MessageDlg( 'Overwrite Existing File: ' + FileName + '?', mtConfirmation, [mbYes, mbNo], 0 );
  268.             if Ans = mrYes then
  269.                DeleteFile( FileName )
  270.             else
  271.                Exit;  // Don't use the new name.
  272.          end;
  273.          SetZipFName( Filename, True );
  274.       end else
  275.          Exit;
  276.       if ZipMaster1.ZipFilename <> '' then
  277.          AddSpan;
  278.    end;
  279. end;
  280.  
  281. procedure TMainForm.AddButClick( Sender: TObject );
  282. begin
  283.    FirstDir2 := FirstDir3;
  284.    if NOT ZipOpenArchive then
  285.       Exit;
  286.    FirstDir3 := FirstDir2;
  287.    if ZipMaster1.ZipFilename = '' then
  288.       Exit;
  289.    AddSpan;
  290. end;
  291.  
  292. procedure TMainForm.AddSpan();
  293. var
  294.    IsOne: String;
  295. begin
  296.    Canceled := False;
  297.    AddFile.ShowModal;  // Let user pick filenames to add.
  298.    if Canceled then
  299.       Exit;
  300.  
  301.    if AddFile.SelectedList.Items.Count = 0 then
  302.    begin
  303.       ShowMessage( 'No files selected' );
  304.       Exit;
  305.    end;
  306. //   MsgForm.RichEdit1.Clear;
  307.    MsgForm.Memo1.Clear;
  308.    MsgForm.Show;
  309.    // Put this message into the message form.
  310. //   with ZipMaster1, AddFile do
  311. //   begin
  312.       ZipMaster1Message( self, 0, 'Beginning Add to ' + ZipMaster1.ZipFilename );
  313.  
  314.       ZipMaster1.AddOptions := [];
  315.       if AddFile.RecurseCB.Checked then   // We want recursion.
  316.          ZipMaster1.AddOptions := ZipMaster1.AddOptions + [AddRecurseDirs];
  317.       if AddFile.DirNameCB.Checked then   // We want dirnames.
  318.          ZipMaster1.AddOptions := ZipMaster1.AddOptions + [AddDirNames];
  319.       ZipMaster1.WriteOptions := [];
  320.       if WipeCB.Checked then    // We want disk spanning with formatting
  321.          ZipMaster1.SpanOptions := ZipMaster1.SpanOptions + [spWipeFiles{, spTryFormat}] ;
  322. //         AddOptions := AddOptions + [AddDiskSpanErase]
  323. //      else                                                                                                                    // We want normal disk spanning
  324.          ZipMaster1.WriteOptions := ZipMaster1.WriteOptions + [zwoDiskSpan];
  325. //         AddOptions := AddOptions + [AddDiskSpan];
  326.       if AddFile.EncryptCB.Checked then   // We want a password.
  327.          ZipMaster1.AddOptions := ZipMaster1.AddOptions + [AddEncrypt];
  328.  
  329.       ZipMaster1.FSpecArgs.Clear;
  330.       ZipMaster1.FSpecArgs.Assign(AddFile.SelectedList.Items );   // Specify filenames.
  331.       AddFile.SelectedList.Clear;
  332.       try
  333.          ZipMaster1.Add;
  334.       except
  335.          ShowMessage( 'Error in Add; Fatal Exception in Main' );
  336.          Exit;
  337.       end;
  338.       if ZipMaster1.SuccessCnt = 1 then
  339.          IsOne := ' was'
  340.       else
  341.          IsOne := 's were';
  342.       ShowMessage( IntToStr(ZipMaster1.SuccessCnt ) + ' file' + IsOne + ' added' );
  343. //   end;
  344. end;
  345.  
  346. procedure TMainForm.WriteBttnClick( Sender: TObject );
  347. var
  348.    InFile, OutFile: String;
  349. begin
  350.    FirstDir2 := FirstDir4;
  351.    if NOT ZipOpenArchive then
  352.       Exit;
  353.    FirstDir4 := FirstDir2;
  354.    InFile := ZipMaster1.ZipFilename;
  355.    if InFile = '' then
  356.      Exit;
  357.  
  358.    if AskDirDialog( MainForm.Handle, OutFile ) then
  359.    begin
  360.       OutFile := OutFile + ExtractFileName( InFile );
  361. //      MsgForm.RichEdit1.Clear;
  362.       MsgForm.Memo1.Clear;
  363.       MsgForm.Show;
  364.       ZipMaster1.WriteSpan( InFile, OutFile );
  365.       MsgForm.Hide;
  366.    end;
  367. end;
  368.  
  369. procedure TMainForm.ExtractButClick( Sender: TObject );
  370. var
  371.    i:     Integer;
  372.    IsOne: String;
  373. begin
  374.    FirstDir2 := FirstDir5;
  375.    if NOT ZipOpenArchive or (ZipMaster1.ZipFilename = '') then
  376.       Exit;
  377.    FirstDir5 := FirstDir2;
  378.  
  379.    Extract.ShowModal;
  380.    if (ExtractDir = '') or (Canceled = True) then
  381.       Exit;
  382.  
  383.    if ZipMaster1.Count < 1 then
  384.    begin
  385.       ShowMessage( 'Error - no files to extract' );
  386.       Exit;
  387.    end;
  388.    with ZipMaster1, StringGrid1 do
  389.    begin
  390.       FSpecArgs.Clear;
  391.       // Get fspecs of selected files, unless user wants all files extracted.
  392.       if NOT AllFiles then
  393.       begin
  394.          for i := Selection.Top to Selection.Bottom do
  395.          begin
  396.             if i <> RowCount - 1 then
  397.             begin
  398.                FSpecArgs.Add( Cells[5, i] + Cells[0, i] );
  399.             end;
  400.          end;
  401.          if FSpecArgs.Count < 1 then
  402.          begin
  403.             ShowMessage( 'Error - no files selected' );
  404.             Exit;
  405.          end;
  406.       end;
  407. //      MsgForm.RichEdit1.Clear;
  408.       MsgForm.Memo1.Clear;
  409.       MsgForm.Show;
  410.       // Put this message into the message form.
  411.       ZipMaster1Message( self, 0, 'Beginning Extract from ' + ZipFilename );
  412.  
  413.       ExtrBaseDir := ExtractDir;
  414.       ExtrOptions := [];
  415.       if ExpandDirs then
  416.          ExtrOptions := ExtrOptions + [ExtrDirNames];
  417.       if OverWr then
  418.          ExtrOptions := ExtrOptions + [ExtrOverWrite];
  419.       try
  420.          Extract;
  421.       except
  422.          ShowMessage( 'Error in Extract; Fatal DLL Exception in Main' );
  423.          Exit;
  424.       end;
  425.       if SuccessCnt = 1 then
  426.          IsOne := ' was'
  427.       else
  428.          IsOne := 's were';
  429.       ShowMessage( IntToStr( SuccessCnt ) + ' file' + IsOne + ' extracted' );
  430.    end;
  431. end;
  432.  
  433. procedure TMainForm.ReadBttnClick( Sender: TObject );
  434. var
  435.    InFile, OutPath, ext: String;
  436.    fd:                   String;
  437.    len :                 LongInt;
  438.    drivetype:            LongWord;
  439. begin
  440.    with OpenDialog1 do
  441.    begin
  442.       Options    := Options + [ofHideReadOnly, ofShareAware, ofPathMustExist, ofFileMustExist];
  443.       Title      := 'Open spanned ZIP archive on last disk';
  444.       Filter     := 'ZIP Files (*.ZIP)|*.zip';
  445.       FileName   := '';
  446.       InitialDir := 'A:\';
  447.       DefaultExt := 'zip';
  448.       if OpenDialog1.Execute then
  449.       begin
  450.          InFile    := FileName;
  451.          fd        := ExtractFileDrive ( InFile ) + '\';
  452.          drivetype := GetDriveType( PChar( fd ) );
  453.          len       := 3;
  454.  
  455.          if (drivetype = DRIVE_FIXED) or (drivetype = DRIVE_REMOTE) then
  456.          begin
  457.             ext := ExtractFileExt( InFile );
  458.             len := Length( InFile ) - Length( ext );
  459.             if StrToIntDef( Copy( InFile, len - 2, 3 ), -1 ) = -1 then
  460.             begin
  461.                ShowMessage( 'This is not a valid (last)part of a spanned archive' );
  462.                Exit;
  463.             end;
  464.          end;
  465.          if AskDirDialog( MainForm.Handle, OutPath ) then
  466.          begin
  467.             if (drivetype = DRIVE_FIXED) or (drivetype = DRIVE_REMOTE) then
  468.                OutPath := OutPath + ExtractFileName( Copy( InFile, 1, len - 3 ) + ext )
  469.             else
  470.                OutPath := OutPath + ExtractFileName( InFile );
  471. //            MsgForm.RichEdit1.Clear;
  472.             MsgForm.Memo1.Clear;
  473.             MsgForm.Show;
  474.             if ZipMaster1.ReadSpan( InFile, OutPath ) = 0 then
  475.                SetZipFName( OutPath, True );
  476.             MsgForm.Hide;
  477.          end;
  478.       end;
  479.    end;
  480. end;
  481.  
  482. procedure TMainForm.Exit1Click( Sender: TObject );
  483. begin
  484.    Close;
  485. end;
  486.  
  487. procedure TMainForm.Showlasterror1Click( Sender: TObject );
  488. begin
  489.    if ZipMaster1.ErrCode <> 0 then
  490.       ShowMessage( IntToStr( ZipMaster1.ErrCode ) + ' ' + ZipMaster1.ErrMessage )
  491.    else
  492.       ShowMessage( 'No last error present' );
  493. end;
  494.  
  495. procedure TMainForm.DLLversioninfo1Click( Sender: TObject );
  496. begin
  497.   ShowMessage('DelZip179.dll ' + ZipMaster1.DLL_Version + #13#10
  498.     + 'at ' + ZipMaster1.DLL_Path);
  499. //   ShowMessage( 'UnZip Dll version: ' + IntToStr( ZipMaster1.UnzVers ) + #10 +
  500. //                                       '  Zip Dll version: ' + IntToStr( ZipMaster1.ZipVers ) );
  501. end;
  502.  
  503. procedure TMainForm.Messages1Click( Sender: TObject );
  504. begin
  505.    MsgForm.Show;
  506. end;
  507.  
  508. procedure TMainForm.FreeDisk1EditChange( Sender: TObject );
  509. begin
  510.    ZipMaster1.KeepFreeOnDisk1 := StrToIntDef( FreeDisk1Edit.Text, 0 );
  511. end;
  512.  
  513. procedure TMainForm.MinFreeVolEditChange( Sender: TObject );
  514. begin
  515.    ZipMaster1.MinFreeVolumeSize := StrToIntDef( MinFreeVolEdit.Text, 65536 );
  516. end;
  517.  
  518. procedure TMainForm.MaxVolSizeEditChange( Sender: TObject );
  519. begin
  520.    ZipMaster1.MaxVolumeSize := StrToIntDef(  MaxVolSizeEdit.Text, 0 );
  521. end;
  522.  
  523. procedure TMainform.SetZipTotals();
  524. begin
  525.    with StringGrid1 do
  526.    begin
  527.       RowCount := RowCount + 1;
  528.       Cells[0, RowCount - 1] := 'Total';
  529.       Cells[1, RowCount - 1] := IntToStr( TotComp );
  530.       Cells[2, RowCount - 1] := IntToStr( TotUncomp );
  531.       if TotUnComp <> 0 then
  532.          Cells[4, RowCount - 1] := IntToStr( Round( (1- (TotComp / TotUnComp) )* 100) ) + '% '
  533.       else
  534.          Cells[4, RowCount - 1] := '0 % ';
  535.       Cells[5, RowCount - 1]    := '';
  536.    end;
  537. end;
  538.  
  539. //---------------------------------------------------------------------------
  540. function TMainform.AskDirDialog( const FormHandle: HWND; var DirPath: String ): Boolean;
  541. var
  542.    pidl:        PItemIDList;
  543.    FBrowseInfo: TBrowseInfo;
  544.    Success:     Boolean;
  545.    TitleName:   String;
  546.    Buffer:      Array[0..MAX_PATH] of Char;
  547. begin
  548.    Result := False;
  549.    ZeroMemory( @FBrowseInfo, SizeOf( FBrowseInfo ) );
  550.    try
  551.       GetMem( FBrowseInfo.pszDisplayName, MAX_PATH );
  552.       FBrowseInfo.hwndOwner := FormHandle;
  553.       TitleName             := 'Please specify a directory';
  554.       FBrowseInfo.lpszTitle := PChar( TitleName );
  555.       pidl := ShBrowseForFolder( FBrowseInfo );
  556.       if pidl <> nil then
  557.       begin
  558.          Success := SHGetPathFromIDList( pidl, Buffer );
  559.          // if False then pidl not part of namespace
  560.          if Success then
  561.          begin
  562.             DirPath := Buffer;
  563.             if DirPath[Length( DirPath )] <> '\' then
  564.                DirPath := DirPath + '\';
  565.             Result := True;
  566.          end;
  567.          GlobalFreePtr( pidl );
  568.       end;
  569.    finally
  570.       if Assigned( FBrowseInfo.pszDisplayName ) then
  571.          FreeMem( FBrowseInfo.pszDisplayName, Max_Path );
  572.    end;
  573. end;
  574.  
  575. {* Folder types are a.o.
  576.  *      CSIDL_DESKTOPDIRECTORY, CSIDL_STARTMENU, CSIDL_SENDTO,
  577.  * CSIDL_PROGRAMS, CSIDL_STARTUP etc.
  578.  *}
  579. function TMainform.GetSpecialFolder( aFolder: Integer; var Location: String ): LongWord;
  580. var
  581.    pidl:      PItemIDList;
  582.    hRes:      HRESULT;
  583.    RealPath:  Array[0..MAX_PATH] of Char;
  584.    Success:   Boolean;
  585. begin
  586.    Result := 0;
  587.    hRes   := SHGetSpecialFolderLocation( Handle, aFolder, pidl );
  588.    if hRes = NO_ERROR then
  589.    begin
  590.       Success := SHGetPathFromIDList( pidl, RealPath );
  591.       if Success then
  592.          Location := String( RealPath ) + '\'
  593.       else
  594.          Result := LongWord( E_UNEXPECTED );
  595.    end else
  596.       Result := hRes;
  597. end;
  598.  
  599. procedure TMainForm.ZipMaster1DirUpdate( Sender: TObject );
  600. begin
  601.    FillGrid;
  602.    FilesLabel.Caption := IntToStr( ZipMaster1.Count );
  603.    SetZipFName( ZipMaster1.ZipFilename, False );
  604. end;
  605.  
  606. procedure TMainForm.ZipMaster1Message( Sender: TObject; ErrCode: Integer; Message: String );
  607. begin
  608. //   MsgForm.RichEdit1.Lines.Append( Message );
  609.    MsgForm.Memo1.Lines.Append( Message );
  610. //   PostMessage( MsgForm.RichEdit1.Handle, EM_SCROLLCARET, 0, 0 );
  611.    PostMessage( MsgForm.Memo1.Handle, EM_SCROLLCARET, 0, 0 );
  612.    Application.ProcessMessages;
  613.    if ErrCode > 0 then
  614.       ShowMessage( 'Error Msg: ' + Message );
  615. end;
  616.  
  617. // TODO: ZipMaster1Progress
  618. //procedure TMainForm.ZipMaster1Progress( Sender: TObject; ProgrType: ProgressType; Filename: String; FileSize: Int64);//Integer );
  619. //var
  620. // Step: Integer;
  621. //begin
  622. // case ProgrType of
  623. //    TotalSize2Process:
  624. //       begin
  625. //          // ZipMaster1Message( self, 0, 'in OnProgress type TotalBytes, size= ' + IntToStr( FileSize ) );
  626. //          MsgForm.StatusBar1.Panels.Items[0].Text := 'Total size: ' + IntToStr( FileSize div 1024 ) + ' Kb';
  627. //          MsgForm.ProgressBar2.Position := 1;
  628. //          TotalSize2                    := FileSize;
  629. //          TotalProgress2                := 0;
  630. //       end;
  631. //    TotalFiles2Process:
  632. //       begin
  633. //          // ZipMaster1Message( self, 0, 'in OnProgress type TotalFiles, files= ' + IntToStr( FileSize ) );
  634. //          MsgForm.StatusBar1.Panels.Items[1].Text := IntToStr( FileSize ) + ' files';
  635. //       end;
  636. //    NewFile:
  637. //       begin
  638. //          // ZipMaster1Message( self, 0, 'in OnProgress type NewFile, size= ' + IntToStr( FileSize ) );
  639. //          MsgForm.FileBeingZipped.Caption := Filename;
  640. //          MsgForm.ProgressBar1.Position   := 1;         // Current position of bar.
  641. //          TotalSize1                      := FileSize;
  642. //          TotalProgress1                  := 0;
  643. //       end;
  644. //    ProgressUpdate:
  645. //       begin
  646. //          // ZipMaster1Message( self, 0, 'in OnProgress type Update, size= ' + IntToStr( FileSize ) );
  647. //          // FileSize gives now the bytes processed since the last call.
  648. //          TotalProgress1 := TotalProgress1 + FileSize;
  649. //          TotalProgress2 := TotalProgress2 + FileSize;
  650. //          if TotalSize1 <> 0 then
  651. //          begin
  652. //             {$IFDEF VERD6up}
  653. //             Step := Integer( Int64(TotalProgress1) * Int64(10000) div Int64(TotalSize1) );
  654. //             {$ELSE}
  655. //             // D4+   (D5 gives a compiler error when using Int64 conversion!?)
  656. //             Step := MulDiv(TotalProgress1, 10000, TotalSize1);
  657. //             {$ENDIF}
  658. //             // ZipMaster1Message( self, 0, 'Step = ' + IntToStr( Step ) );
  659. //             MsgForm.ProgressBar1.Position := 1 + Step;
  660. //          end else
  661. //             MsgForm.ProgressBar1.Position := 10001;
  662. //          if TotalSize2 <> 0 then
  663. //          begin
  664. //             {$IFDEF VERD6up}
  665. //             Step := Integer( Int64(TotalProgress2) * Int64(10000) div Int64(TotalSize2) );
  666. //             {$ELSE}
  667. //             Step := MulDiv(TotalProgress2, 10000, TotalSize2);
  668. //             {$EndIf}
  669. //             MsgForm.ProgressBar2.Position := 1 + Step;
  670. //          end;
  671. //       end;
  672. //    EndOfBatch:    // Reset the progress bar and filename.
  673. //       begin
  674. //          // ZipMaster1Message( self, 0, 'in OnProgress type EndOfBatch' );
  675. //          MsgForm.FileBeingZipped.Caption   := '';
  676. //          MsgForm.ProgressBar1.Position     := 1;
  677. //          MsgForm.StatusBar1.Panels[0].Text := '';
  678. //          MsgForm.StatusBar1.Panels[1].Text := '';
  679. //          MsgForm.ProgressBar2.Position     := 1;
  680. //       end;
  681. // end;   // EOF Case
  682. //end;
  683.  
  684. procedure TMainform.SetZipFName( aCaption: String; AssignName: Boolean );
  685. begin
  686.    with ZipFName, ZipMaster1 do
  687.    begin
  688.       // Assigning the filename will cause the table of contents to be read.
  689.       // and possibly reset it to an empty string (If error found).
  690.       if AssignName then
  691.          ZipFilename := aCaption;
  692.  
  693.       if ZipFilename = '' then
  694.          Caption := AnsiString( '<none>' )
  695.       else
  696.          Caption := MinimizeName( ZipFilename, Canvas, Width );
  697.  
  698.       if Canvas.TextWidth( ZipFilename ) > Width then
  699.       begin
  700.          Hint     := ZipFilename;
  701.          ShowHint := True;
  702.       end else
  703.          ShowHint := False;
  704.    end;
  705. end;
  706.  
  707. function TMainForm.ZipOpenArchive(): Boolean;
  708. begin
  709.    Result := False;
  710.    if FirstDir2 = '' then
  711.       GetSpecialFolder( CSIDL_DESKTOPDIRECTORY, FirstDir2 );
  712.    with OpenDialog1 do
  713.    begin
  714.       InitialDir := FirstDir2;
  715.       Title      := 'Open Existing ZIP File';
  716.       Filter     := 'ZIP Files (*.ZIP)|*.zip';
  717.       FileName   := '';
  718.       Options    := Options + [ofHideReadOnly, ofShareAware, ofPathMustExist, ofFileMustExist];
  719.       if Execute then
  720.       begin
  721.          FirstDir2 := ExtractFilePath( FileName );
  722.          // Assigning the filename will cause the table of contents to be read.
  723.          SetZipFName( Filename, True );
  724.          Result := True;
  725.       end;
  726.    end;
  727. end;
  728.  
  729. procedure TMainForm.StringGrid1BeginSort( Sender: TObject; Col: LongInt; var SortOptions: TSortOptions );
  730. begin
  731.    StringGrid1.RowCount := StringGrid1.RowCount - 1;
  732. end;
  733.  
  734. procedure TMainForm.StringGrid1ClickSort( Sender: TObject; Col, Row: LongInt; var SortOptions: TSortOptions );
  735. begin
  736.    with GSortOptions do
  737.    begin
  738.       if SortDirection = sdAscending then
  739.          SortDirection := sdDescending
  740.       else
  741.          SortDirection := sdAscending;
  742.    end;
  743.    GSortCol    := Col;
  744.    SortOptions := GSortOptions;
  745. end;
  746.  
  747. procedure TMainForm.StringGrid1DrawCell( Sender: TObject; Col, Row: LongInt; Rect: TRect; State: TGridDrawState );
  748. var
  749.    i: Integer;
  750. begin
  751.    if (Row = 0) and (Col = GSortCol) then
  752.    begin
  753.       i := 1;
  754.       if GSortOptions.SortDirection = sdAscending then
  755.          i := 0;
  756.       ImageList1.Draw( StringGrid1.Canvas, Rect.Right - 18, 1, i );
  757.    end
  758. end;
  759.  
  760. procedure TMainForm.StringGrid1EndSort( Sender: TObject; Col: LongInt );
  761. begin
  762.    SetZipTotals;
  763. end;
  764.  
  765. procedure TMainForm.StringGrid1GetCellFormat( Sender: TObject; Col, Row: LongInt; State: TGridDrawState; var FormatOptions: TFormatOptions );
  766. begin
  767.    with FormatOptions do
  768.    begin
  769.       if (Row <> 0) and (Col <> 0) and (Col <> 5) then
  770.          AlignmentHorz := taRightJustify;
  771.       if Row = StringGrid1.RowCount - 1 then
  772.       begin
  773.          Font.Style := Font.Style + [fsBold];
  774.          Font.Color := clRed;
  775.       end;
  776.    end;
  777. end;
  778.  
  779. procedure TMainForm.FillGrid;
  780. var
  781.   i: Integer;
  782. begin
  783.   with StringGrid1 do
  784.   begin
  785.     { remove everything from grid except col titles }
  786.     RowCount := 2;
  787.     Rows[1].Clear;
  788.     if ZipMaster1.Count = 0 then
  789.        Exit;
  790.  
  791.     StringGrid1.RowCount := ZipMaster1.Count + 2;
  792.     TotUnComp := 0;
  793.     TotComp   := 0;
  794.     for i := 1 to ZipMaster1.Count do
  795.     begin
  796. //       with ZipDirEntry( ZipMaster1.ZipContents[i - 1]^ ) do
  797.        with ZipMaster1[i - 1] do
  798.        begin
  799.           Cells[0, i] := ExtractFileName( FileName );
  800.           Cells[1, i] := IntToStr( CompressedSize );
  801.           Cells[2, i] := IntToStr( UncompressedSize );
  802.           Cells[3, i] := FormatDateTime( 'ddddd  t', FileDateToDateTime( DateTime ) );
  803.           if UncompressedSize <> 0 then
  804.              Cells[4, i] := IntToStr( Round( (1- (CompressedSize / UnCompressedSize) )* 100) ) + '% '
  805.           else
  806.              Cells[4, i] := '0% ';
  807.           Cells[5, i] := ExtractFilePath( FileName );
  808.           TotUncomp   := TotUnComp + Cardinal(UncompressedSize);
  809.           Inc( TotComp, CompressedSize );
  810.        end; // end with
  811.     end; // end for
  812.     SortByColumn( GSortCol, GSortOptions );
  813.     Row := 1;
  814.   end; // end with
  815. end;
  816.  
  817. procedure TMainForm.ZipMaster1Progress(Sender: TObject; details:
  818.     TZMProgressDetails);
  819. begin
  820.    case Details.Order of
  821.       TotalSize2Process:
  822.          begin
  823.             // ZipMaster1Message( self, 0, 'in OnProgress type TotalBytes, size= ' + IntToStr( FileSize ) );
  824.             MsgForm.StatusBar1.Panels.Items[0].Text := 'Total size: ' + IntToStr(Details.TotalSize div 1024 ) + ' Kb';
  825.             MsgForm.ProgressBar2.Position := 1;
  826.             MsgForm.ProgressBar1.Max := 100;
  827.             MsgForm.ProgressBar2.Max := 100;
  828. //            TotalSize2                    := Details.TotalSize;
  829. //            TotalProgress2                := 0;
  830.          end;
  831.       TotalFiles2Process:
  832.          begin
  833.             // ZipMaster1Message( self, 0, 'in OnProgress type TotalFiles, files= ' + IntToStr( FileSize ) );
  834.             MsgForm.StatusBar1.Panels.Items[1].Text := IntToStr(details.TotalCount) + ' files';
  835.          end;
  836.       NewFile:
  837.          begin
  838.             // ZipMaster1Message( self, 0, 'in OnProgress type NewFile, size= ' + IntToStr( FileSize ) );
  839.             MsgForm.FileBeingZipped.Caption := details.ItemName;
  840.             MsgForm.ProgressBar1.Position   := 1;         // Current position of bar.
  841. //            TotalSize1                      := details.ItemSize;
  842. //            TotalProgress1                  := 0;
  843.          end;
  844.       ProgressUpdate:
  845.          begin
  846.             // ZipMaster1Message( self, 0, 'in OnProgress type Update, size= ' + IntToStr( FileSize ) );
  847.             // FileSize gives now the bytes processed since the last call.
  848. //            TotalProgress1 := TotalProgress1 + FileSize;
  849. //            TotalProgress2 := TotalProgress2 + FileSize;
  850. //            if TotalSize1 <> 0 then
  851. //            begin
  852. //               {$IFDEF VERD6up}
  853. //               Step := Integer( Int64(TotalProgress1) * Int64(10000) div Int64(TotalSize1) );
  854. //               {$ELSE}
  855. //               // D4+   (D5 gives a compiler error when using Int64 conversion!?)
  856. //               Step := MulDiv(TotalProgress1, 10000, TotalSize1);
  857. //               {$ENDIF}
  858.                // ZipMaster1Message( self, 0, 'Step = ' + IntToStr( Step ) );
  859.                MsgForm.ProgressBar1.Position := details.ItemPerCent;
  860. //            end else
  861. //               MsgForm.ProgressBar1.Position := 10001;
  862. //            if TotalSize2 <> 0 then
  863. //            begin
  864. //               {$IFDEF VERD6up}
  865. //               Step := Integer( Int64(TotalProgress2) * Int64(10000) div Int64(TotalSize2) );
  866. //               {$ELSE}
  867. //               Step := MulDiv(TotalProgress2, 10000, TotalSize2);
  868. //               {$EndIf}
  869.                MsgForm.ProgressBar2.Position := details.TotalPerCent;
  870. //            end;
  871.          end;
  872.       EndOfBatch:    // Reset the progress bar and filename.
  873.          begin
  874.             // ZipMaster1Message( self, 0, 'in OnProgress type EndOfBatch' );
  875.             MsgForm.FileBeingZipped.Caption   := '';
  876.             MsgForm.ProgressBar1.Position     := 1;
  877.             MsgForm.StatusBar1.Panels[0].Text := '';
  878.             MsgForm.StatusBar1.Panels[1].Text := '';
  879.             MsgForm.ProgressBar2.Position     := 1;
  880.          end;
  881.    end;   // EOF Case
  882. end;
  883.  
  884. end.
  885.  
  886.