home *** CD-ROM | disk | FTP | other *** search
/ Hot Shareware 37 / hot37.iso / FICHEROS / 9TOOL / ADDZIP.ZIP / DELPHI / QUICKZIP / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-02-01  |  36KB  |  1,118 lines
  1. unit Main;
  2.  
  3. interface
  4. {
  5. If you wish to use the "text box" method of processing messages from the
  6. compression DLL's, then compile the project with the conditional define of USE_CALLBACKS
  7. }
  8.  
  9. uses
  10.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  11.   Forms, Dialogs, StdCtrls, ShellAPI, Menus, Buttons, ExtCtrls, About, Replace, 
  12.   AZIP, AUNZIP, AddZipu, AddZipC;
  13.  
  14. type
  15.   TQuikZip = class(TForm)
  16.     txtZip: TEdit;
  17.     lstArchive: TListBox;
  18.     mnuMain: TMainMenu;
  19.     mnuArchive: TMenuItem;
  20.     mnuOptions: TMenuItem;
  21.     mnuHelp: TMenuItem;
  22.     mnuArchiveNew: TMenuItem;
  23.     mnuArchiveOpen: TMenuItem;
  24.     mnuArchiveSep1: TMenuItem;
  25.     mnuArchiveExit: TMenuItem;
  26.     mnuHelpAbout: TMenuItem;
  27.     mnuOptionsCompression: TMenuItem;
  28.     mnuOptionsStoreFull: TMenuItem;
  29.     mnuOptionsSep1: TMenuItem;
  30.     mnuOptionsExtractTo: TMenuItem;
  31.     mnuOptionsCompressionNone: TMenuItem;
  32.     mnuOptionsCompressionMinimum: TMenuItem;
  33.     mnuOptionsCompressionNormal: TMenuItem;
  34.     mnuOptionsCompressionMaximum: TMenuItem;
  35.     btnNew: TSpeedButton;
  36.     btnOpen: TSpeedButton;
  37.     btnDelete: TSpeedButton;
  38.     btnExtract: TSpeedButton;
  39.     btnView: TSpeedButton;
  40.     hdrArchive: THeader;
  41.     pnlStatusBar: TPanel;
  42.     mnuPopup: TPopupMenu;
  43.     mnuPopupSelectAll: TMenuItem;
  44.     mnuPopupDeselectAll: TMenuItem;
  45.     mnuPopupInvert: TMenuItem;
  46.     mnuPopupSep: TMenuItem;
  47.     mnuPopupExtract: TMenuItem;
  48.     mnuPopupView: TMenuItem;
  49.     mnuPopupDelete: TMenuItem;
  50.     mnuOptionsSep2: TMenuItem;
  51.     mnuOptionsOnTop: TMenuItem;
  52.     mnuSFX: TMenuItem;
  53.     procedure FormShow(Sender: TObject);
  54.     procedure txtZipChange(Sender: TObject);
  55.     procedure mnuHelpAboutClick(Sender: TObject);
  56.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  57.     procedure btnOpenClick(Sender: TObject);
  58.     procedure mnuArchiveOpenClick(Sender: TObject);
  59.     procedure mnuOptionsStoreFullClick(Sender: TObject);
  60.     procedure lstArchiveDrawItem(Control: TWinControl; Index: Integer;
  61.       Rect: TRect; State: TOwnerDrawState);
  62.     procedure hdrArchiveSized(Sender: TObject; ASection, AWidth: Integer);
  63.     procedure mnuOptionsCompressionNormalClick(Sender: TObject);
  64.     procedure mnuOptionsCompressionNoneClick(Sender: TObject);
  65.     procedure mnuOptionsCompressionMinimumClick(Sender: TObject);
  66.     procedure mnuOptionsCompressionMaximumClick(Sender: TObject);
  67.     procedure FormResize(Sender: TObject);
  68.     procedure mnuOptionsExtractToClick(Sender: TObject);
  69.     procedure btnNewClick(Sender: TObject);
  70.     procedure mnuArchiveNewClick(Sender: TObject);
  71.     procedure mnuPopupPopup(Sender: TObject);
  72.     procedure mnuPopupSelectAllClick(Sender: TObject);
  73.     procedure mnuPopupDeselectAllClick(Sender: TObject);
  74.     procedure mnuPopupInvertClick(Sender: TObject);
  75.     procedure mnuOptionsOnTopClick(Sender: TObject);
  76.     procedure FormCreate(Sender: TObject);
  77.     procedure mnuPopupDeleteClick(Sender: TObject);
  78.     procedure btnDeleteClick(Sender: TObject);
  79.     procedure mnuPopupExtractClick(Sender: TObject);
  80.     procedure btnExtractClick(Sender: TObject);
  81.     procedure mnuPopupViewClick(Sender: TObject);
  82.     procedure btnViewClick(Sender: TObject);
  83.     procedure mnuSFXClick(Sender: TObject);
  84.     procedure lstArchiveMeasureItem(Control: TWinControl; Index: Integer;
  85.       var Height: Integer);
  86.     private
  87.     { Private declarations }
  88.     function Trim(s: string): string;
  89.     function OpenArchive : Boolean;
  90.     procedure ListArchiveContents;
  91.     procedure AddFilesToArchive(pFile : PChar);
  92.     procedure UpdateStatusbar;
  93.     function GetItem(const sValue, sSep : String; const iItem : Integer): String;
  94.     Function GetPathName (CurrentPath : String) : String;
  95.     Function GetNewArchive : String;
  96.     procedure NewArchive;
  97.     procedure ProcessDroppedFiles(var MSG: Tmessage); message WM_DROPFILES;
  98.     procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;
  99.     procedure DeleteFilesFromArchive;
  100.     procedure TopMostOn;
  101.     procedure TopMostOff;
  102.     procedure ExtractFilesFromArchive;
  103.     procedure ViewFiles;
  104.   public
  105.     { Public declarations }
  106.   end;
  107.  
  108. {$IFDEF USE_CALLBACKS}
  109.   Type
  110.      {$IFNDEF WIN32} Short = ShortInt; {$ENDIF}
  111.      TProcessCallbackData = function (iLibrary, iMessage : Short; pInfo : PChar) : Integer;
  112.      {$IFDEF WIN32} stdcall; {$ENDIF}
  113.  
  114.  
  115.   function ProcessCallbackData(iLibrary, iMessage : Short; pInfo : PChar) : Integer;
  116.            {$IFDEF WIN32} stdcall; {$ENDIF} export;
  117. {$ENDIF}
  118.  
  119. var
  120.   QuikZip: TQuikZip;
  121.   g_cArchiveName : PChar;
  122.   g_cExtract : String;
  123.   g_cTemp : String;
  124.   g_iCount : Integer; { the total number of files in the archive}
  125.   g_lSize : Longint;  { the total size (uncompressed) of the files in the archive}
  126.   g_iWidth : Integer;
  127.   g_iPathLen : Integer;
  128.   {$IFDEF USE_CALLBACKS}
  129.   MyCallback : TProcessCallbackData;
  130.   {$ENDIF}
  131.  
  132. implementation
  133.  
  134. {$R *.DFM}
  135.  
  136. {Supresses leading and trailing blanks}
  137. function TQuikZip.Trim(s : string) : string;
  138. var
  139.   sLen : byte absolute s;
  140. begin
  141.   while (sLen>0) and (s[1] in [' ',^I]) do
  142.     Delete(s,1,1);
  143.  
  144.   while (sLen>0) and (s[sLen] in [' ',^I]) do
  145.     Dec(sLen);
  146.  
  147.   result:=s;
  148. end;
  149.  
  150. procedure TQuikZip.FormShow(Sender: TObject);
  151. var
  152.    i : integer;
  153. begin
  154.     {$IFDEF WIN32}
  155.        g_iPathLen := 255;
  156.        mnuSFX.Enabled := False;
  157.     {$ELSE}
  158.        g_iPathLen := 127;
  159.        mnuSFX.Enabled := True;
  160.     {$ENDIF}
  161.     {$IFDEF USE_CALLBACKS}
  162.     MyCallback := ProcessCallBackData;
  163.     {$ENDIF}
  164.     I := addZIP_SetParentWindowHandle(QuikZip.Handle);
  165.     I := addUNZIP_SetParentWindowHandle(QuikZip.Handle);
  166.     {$IFNDEF USE_CALLBACKS}
  167.     I := addZIP_SetWindowHandle(txtZIP.handle);
  168.     I := addUNZIP_SetWindowHandle(txtZIP.handle);
  169.     {$ENDIF}
  170.     addZIP_Initialise;
  171.     addUNZIP_Initialise;
  172.     {$IFDEF USE_CALLBACKS}
  173.     I := addZip_InstallCallback(@MyCallback);
  174.     I := addUNZip_InstallCallback(@MyCallback);
  175.     {$ENDIF}
  176.     g_cExtract := ExtractFilePath(Application.ExeName);
  177.     g_cArchiveName := StrAlloc(g_iPathLen);
  178.     TopMostOn;
  179. end;
  180.  
  181. procedure TQuikZip.txtZipChange(Sender: TObject);
  182. {$IFNDEF USE_CALLBACKS}
  183. var
  184.    cAdditem : String;
  185.    lSize : LongInt;
  186.    iWidth, iAction : Integer;
  187. {$ENDIF}
  188. begin
  189.    {$IFNDEF USE_CALLBACKS}
  190.     iAction := StrToInt(GetAction((txtZIP.Text)));
  191.  
  192.     Case iAction of
  193.         AM_SEARCHING : begin
  194.             {comment}
  195.             end;
  196.         AM_ZIPCOMMENT : begin
  197.             {comment}
  198.              end;
  199.         AM_ZIPPING : begin
  200.           cAdditem := 'Zipping ' + GetPiece((txtZIP.Text), '|', 4);
  201.           cAdditem := cAdditem + ' - ' + GetPercentComplete((txtZIP.Text));
  202.           pnlStatusBar.Caption := cAdditem;
  203.           pnlStatusBar.Update;
  204.             end;
  205.         AM_ZIPPED : begin
  206.             {comment}
  207.              end;
  208.         AM_UNZIPPING : begin
  209.           cAdditem := 'Unzipping ' + GetPiece((txtZIP.Text), '|', 4);
  210.           cAdditem := cAdditem + ' - ' + GetPercentComplete((txtZIP.Text));
  211.           pnlStatusBar.Caption := cAdditem;
  212.           pnlStatusBar.Update;
  213.             end;
  214.         AM_UNZIPPED : begin
  215.             {comment}
  216.              end;
  217.         AM_TESTING : begin
  218.             {comment}
  219.              end;
  220.         AM_TESTED : begin
  221.             {comment}
  222.              end;
  223.         AM_DELETING : begin
  224.             {comment}
  225.              end;
  226.         AM_DELETED : begin
  227.             {comment}
  228.              end;
  229.         AM_DISKCHANGE : begin
  230.             {comment}
  231.              end;
  232.         AM_VIEW : begin
  233.               If Trim(GetViewFileName((txtZIP.Text))) <> '' then
  234.                  begin
  235.                     cAdditem := GetViewFileName((txtZIP.Text)) + #9;
  236.                     iWidth := Pos(#9, cAdditem);
  237.                     If iWidth > g_iWidth then
  238.                         begin
  239.                            g_iWidth := iWidth;
  240.                            hdrArchive.SectionWidth[0] := g_iWidth * 7
  241.                         end;
  242.                     lSize := GetFileOriginalSize((txtZIP.Text));
  243.                     g_lSize := g_lSize + lSize;
  244.                     cAdditem := cAdditem + GetFileDate((txtZIP.Text)) + #9;
  245.                     cAdditem := cAdditem + GetFileTime((txtZIP.Text)) + #9;
  246.                     cAdditem := cAdditem + IntToStr(lSize) + #9;
  247.                     cAdditem := cAdditem + IntToStr(GetFileCompressedSize((txtZIP.Text))) + #9;
  248.                     cAdditem := cAdditem + GetFileCompressionRatio((txtZIP.Text)) + #9;
  249.                     cAdditem := cAdditem + GetFilePath((txtZIP.Text)) + #9;
  250.                     lstArchive.Items.Add(cAdditem);
  251.                     g_iCount := g_iCount + 1;
  252.                  end;
  253.            end;
  254.         AM_ERROR : begin
  255.             {error}
  256.              end;
  257.         AM_WARNING : begin
  258.             {warning}
  259.              end;
  260.         AM_QUERYOVERWRITE : begin
  261.             {comment}
  262.              end;
  263.         AM_COPYING : begin
  264.             {comment}
  265.              end;
  266.         AM_COPIED : begin
  267.             {comment}
  268.              end;
  269.      end;
  270. {$ENDIF}
  271. end;
  272.  
  273. procedure TQuikZip.mnuHelpAboutClick(Sender: TObject);
  274. begin
  275.    with TAboutBox.Create(Self) do
  276.    try
  277.       TopMostOff;
  278.       ShowModal;
  279.    finally
  280.       TopMostOn;
  281.       Free;
  282.    end;
  283. end;
  284.  
  285. procedure TQuikZip.FormClose(Sender: TObject; var Action: TCloseAction);
  286. begin
  287.    StrDispose(g_cArchiveName);
  288.    DragAcceptFiles(Handle, False);
  289.    Action := caFree;
  290. end;
  291.  
  292. Function TQuikZip.OpenArchive : Boolean;
  293. begin
  294.  
  295.    OpenArchive := False;
  296.  
  297.    TopMostOff;
  298.    with TOpenDialog.Create(Self) do
  299.    try
  300.       Filename := '*.ZIP';
  301.       InitialDir := ExtractFilePath(Application.Exename);
  302.       DefaultExt := '.ZIP';
  303.       {$IFDEF WIN32}
  304.       Filter := 'ZIP Archives|*.zip';
  305.       {$ELSE}
  306.       Filter := 'ZIP Archives|*.zip|SFX Archives|*.exe';
  307.       {$ENDIF}
  308.       FilterIndex := 1;
  309.       Title := 'Open Archive';
  310.       HelpContext := 0;
  311.       Options := Options + [ofFileMustExist];
  312.  
  313.       if Execute then
  314.          begin
  315.             g_iWidth := 15;
  316.             hdrArchive.SectionWidth[0] := g_iWidth * 6;
  317.             If Trim(Filename) <> '' Then
  318.                begin
  319.                   OpenArchive := True;
  320.                   StrPCopy (g_cArchiveName, Trim(Filename));
  321.                end;
  322.          end
  323.    finally
  324.      Free
  325.    end;
  326.    TopMostOn;
  327.  
  328. end;
  329.  
  330. procedure TQuikZip.ListArchiveContents;
  331. var
  332.    i : Integer;
  333. begin
  334.    QuikZip.Caption := 'QuickZIP - ' + StrPas(g_cArchiveName);
  335.    g_iCount := 0;
  336.    g_lSize := 0;
  337.    lstArchive.Clear;
  338.    Screen.Cursor := crHourglass;
  339.    {$IFNDEF USE_CALLBACKS}
  340.    i := addZIP_SetWindowHandle(txtZIP.handle);
  341.    {$ENDIF}
  342.    i := addZIP_ArchiveName(g_cArchiveName);
  343.    i := addZIP_View(True);
  344.    i := addZIP;
  345.    UpdateStatusBar;
  346.    Screen.Cursor := crDefault;
  347. end;
  348.  
  349. procedure TQuikZip.btnOpenClick(Sender: TObject);
  350. var
  351.    Result : Boolean;
  352. begin
  353.    Result := OpenArchive;
  354.    If Result = True then
  355.       ListArchiveContents;
  356. end;
  357.  
  358. procedure TQuikZip.mnuArchiveOpenClick(Sender: TObject);
  359. var
  360.    Result : Boolean;
  361. begin
  362.    Result := OpenArchive;
  363.    If Result = True then
  364.       ListArchiveContents;
  365. end;
  366.  
  367. procedure TQuikZip.AddFilesToArchive(pFile : PChar);
  368. var
  369.    i : Integer;
  370. begin
  371.     If (mnuOptionsCompressionNone.Checked = True) Then
  372.         i := addZIP_SetCompressionLevel(azCOMPRESSION_NONE)
  373.     Else If (mnuOptionsCompressionMinimum.Checked = True) Then
  374.         i := addZIP_SetCompressionLevel(azCOMPRESSION_MINIMUM)
  375.     Else If (mnuOptionsCompressionNormal.Checked = True) Then
  376.         i := addZIP_SetCompressionLevel(azCOMPRESSION_NORMAL)
  377.     Else
  378.         i := addZIP_SetCompressionLevel(azCOMPRESSION_MAXIMUM);
  379.  
  380.     If (mnuOptionsStoreFull.Checked = False) Then
  381.         i := addZIP_SaveStructure(azSTRUCTURE_NONE);
  382.  
  383.     Screen.Cursor := crHourglass;
  384.     i := addZIP_Include(pFile);
  385.     i := addZIP_ArchiveName(g_cArchiveName);
  386.     i := addZIP;
  387.     Screen.Cursor := crDefault;
  388. end;
  389.  
  390. procedure TQuikZip.mnuOptionsStoreFullClick(Sender: TObject);
  391. begin
  392.    mnuOptionsStoreFull.Checked := Not mnuOptionsStoreFull.Checked;
  393. end;
  394.  
  395. procedure TQuikZip.UpdateStatusBar;
  396. var
  397.    cStatus : String;
  398. begin
  399.     If (g_iCount > 0) Then
  400.        begin
  401.           cStatus := ' This archive contains ' + Format('%.0n', [Int(g_iCount)]) + ' files, ';
  402.           cStatus := cStatus + 'with a total uncompressed size of ' + Format('%.0n', [Int(g_lSize)]) + ' bytes';
  403.        end
  404.     Else
  405.        cStatus := '';
  406.     pnlStatusBar.Caption := cStatus;
  407. end;
  408.  
  409. procedure TQuikZip.lstArchiveDrawItem(Control: TWinControl; Index: Integer;
  410.   Rect: TRect; State: TOwnerDrawState);
  411. var
  412.   sText, sFile, sRatio, sPath : String;
  413.   lSize, lCompSize : Longint;
  414.   iOldRight : Integer;
  415.   sDate, sTime : String;
  416.   P : array[0..255] of Char;
  417. begin
  418.   {Based on code written by Arjen Broeze.}
  419.   with TListBox(Control) do
  420.    begin
  421.      sText := Items[Index];
  422.      sFile := GetItem(sText, #9, 1);
  423.      sDate := GetItem(sText, #9, 2);
  424.      sTime := GetItem(sText, #9, 3);
  425.      lSize := StrToInt(GetItem(sText, #9, 4));
  426.      lCompSize := StrToInt(GetItem(sText, #9, 5));
  427.      sRatio := GetItem(sText, #9, 6);
  428.      sPath := GetItem(sText, #9, 7);
  429.      with Canvas do
  430.       begin
  431.          FillRect(Rect);
  432.          StrPCopy(P, sFile);
  433.          DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
  434.          inc(Rect.left, hdrArchive.SectionWidth[0]);
  435.          StrPCopy(P, sDate);
  436.          DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
  437.          inc(Rect.left, hdrArchive.SectionWidth[1]);
  438.          StrPCopy(P, sTime);
  439.          DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
  440.          inc(Rect.left, hdrArchive.SectionWidth[2]);
  441.          StrPCopy(P, Format('%.0n', [Int(lSize)]));
  442.          iOldRight := Rect.Right;
  443.          Rect.right := Rect.left + hdrArchive.SectionWidth[3]-3;
  444.          DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
  445.          inc(Rect.left, hdrArchive.SectionWidth[3]);
  446.          Rect.right := Rect.left + hdrArchive.SectionWidth[4]-3;
  447.          StrPCopy(P, sRatio);
  448.          DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
  449.          inc(Rect.left, hdrArchive.SectionWidth[4]);
  450.          Rect.right := Rect.left + hdrArchive.SectionWidth[5]-3;
  451.          StrPCopy(P, Format('%.0n', [Int(lCompSize)]));
  452.          DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
  453.          inc(Rect.left, hdrArchive.SectionWidth[5]+3);
  454.          Rect.Right := iOldRight;
  455.          StrPCopy(P, sPath);
  456.          DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
  457.       end;
  458.    end;
  459.  
  460. end;
  461.  
  462. function TQuikZip.GetItem(const sValue, sSep : String; const iItem : Integer): String;
  463. var
  464.   iPos,
  465.   iCount,
  466.   iSepLen : Integer;
  467.   sVal    : String;
  468. begin
  469.   sVal := sValue;
  470.   Result := '';
  471.   iSepLen := Length(sSep);
  472.   iCount := 1;
  473.   iPos := Pos(sSep, sValue);
  474.   while (iPos > 0) and (iCount < iItem) do
  475.    begin
  476.      inc(iCount);
  477.      sVal := Copy(sVal, iPos+iSepLen, Length(sVal));
  478.      iPos := Pos(sSep, sVal);
  479.    end;
  480.   if iCount = iItem then
  481.    begin
  482.      if iPos = 0 then
  483.       { last item }
  484.       Result := sVal
  485.      else
  486.       Result :=    Copy(sVal, 1, iPos-1);
  487.    end;
  488. end;
  489.  
  490. procedure TQuikZip.hdrArchiveSized(Sender: TObject; ASection,
  491.   AWidth: Integer);
  492. begin
  493.    lstArchive.Repaint;
  494. end;
  495.  
  496. procedure TQuikZip.mnuOptionsCompressionNormalClick(Sender: TObject);
  497. begin
  498.    mnuOptionsCompressionNormal.Checked := not mnuOptionsCompressionNormal.Checked;
  499.    If mnuOptionsCompressionNormal.Checked = True then
  500.       begin
  501.          mnuOptionsCompressionNone.Checked := False;
  502.          mnuOptionsCompressionMinimum.Checked := False;
  503.          mnuOptionsCompressionMaximum.Checked := False;
  504.       end;
  505. end;
  506.  
  507. procedure TQuikZip.mnuOptionsCompressionNoneClick(Sender: TObject);
  508. begin
  509.    mnuOptionsCompressionNone.Checked := not mnuOptionsCompressionNone.Checked;
  510.    If mnuOptionsCompressionNone.Checked = True then
  511.       begin
  512.          mnuOptionsCompressionNormal.Checked := False;
  513.          mnuOptionsCompressionMinimum.Checked := False;
  514.          mnuOptionsCompressionMaximum.Checked := False;
  515.       end;
  516. end;
  517.  
  518. procedure TQuikZip.mnuOptionsCompressionMinimumClick(Sender: TObject);
  519. begin
  520.    mnuOptionsCompressionMinimum.Checked := not mnuOptionsCompressionMinimum.Checked;
  521.    If mnuOptionsCompressionMinimum.Checked = True then
  522.       begin
  523.          mnuOptionsCompressionNone.Checked := False;
  524.          mnuOptionsCompressionNormal.Checked := False;
  525.          mnuOptionsCompressionMaximum.Checked := False;
  526.       end;
  527. end;
  528.  
  529. procedure TQuikZip.mnuOptionsCompressionMaximumClick(Sender: TObject);
  530. begin
  531.    mnuOptionsCompressionMaximum.Checked := not mnuOptionsCompressionMaximum.Checked;
  532.    If mnuOptionsCompressionMaximum.Checked = True then
  533.       begin
  534.          mnuOptionsCompressionNone.Checked := False;
  535.          mnuOptionsCompressionMinimum.Checked := False;
  536.          mnuOptionsCompressionNormal.Checked := False;
  537.       end;
  538. end;
  539.  
  540. procedure TQuikZip.FormResize(Sender: TObject);
  541. begin
  542.    pnlStatusBar.Top := Height - pnlStatusbar.Height - 48;
  543.    pnlStatusBar.Width := Width - 8;
  544.    lstArchive.Height := pnlStatusBar.Top - lstArchive.Top - 5;
  545.    hdrArchive.Width := Width - 8;
  546.    lstArchive.Width := Width - 8;
  547. end;
  548.  
  549. procedure TQuikZip.mnuOptionsExtractToClick(Sender: TObject);
  550. var
  551.    sResult : String;
  552. begin
  553.    sResult := GetpathName(g_cExtract);
  554.    If Trim(sresult) <> '' Then
  555.       g_cExtract := sResult;
  556. end;
  557.  
  558. Function TQuikZip.GetPathName (CurrentPath : String) : String;
  559. var
  560.    DirPath, sTempFilepath : String;
  561.    iEndPos : Integer;
  562. begin
  563.  
  564.    If Trim(CurrentPath) <> '' Then
  565.        DirPath := Trim(CurrentPath)
  566.    Else
  567.        DirPath := 'C:\';
  568.  
  569.    TopMostOff;
  570.  
  571.    with TOpenDialog.Create(Self) do
  572.    try
  573.       Title := 'Set Extract Directory';
  574.       Filename := 'IGNOREME.TXT';
  575.       InitialDir := DirPath;
  576.       DefaultExt := '.TXT';
  577.       Filter := 'All Files (*.*)|*.*';
  578.       FilterIndex := 1;
  579.       HelpContext := 0;
  580.       Options := Options + [ofPathMustExist];
  581.  
  582.       if Execute then
  583.          begin
  584.             If Length(Filename) <= 12 Then
  585.                sTempFilepath := ''
  586.             Else
  587.                sTempFilepath := Filename;
  588.  
  589.             If Trim(sTempFilepath) <> '' Then
  590.                begin
  591.                   iEndPos := Pos('IGNOREME.TXT', UpperCase(sTempFilepath));
  592.                   If iEndPos <> 0 Then
  593.                       GetPathName := ExtractFilepath(sTempFilepath)
  594.                   Else
  595.                       GetPathName := CurrentPath;
  596.                end
  597.             Else
  598.                GetPathName := CurrentPath;
  599.          End
  600.       Else
  601.          GetPathName := CurrentPath
  602.    finally
  603.      Free
  604.    end;
  605.  
  606.    TopMostOn;
  607.  
  608. End;
  609.  
  610. Function TQuikZip.GetNewArchive : String;
  611. begin
  612.  
  613.  
  614.    TopMostOff;
  615.  
  616.    with TOpenDialog.Create(Self) do
  617.    try
  618.       Title := 'Enter a name for a .ZIP archive';
  619.       Filename := '';
  620.       InitialDir := ExtractFilepath(Application.ExeName);
  621.       DefaultExt := '.ZIP';
  622.       Filter := 'ZIP Files (*.ZIP)|*.ZIP|All Files (*.*)|*.*';
  623.       FilterIndex := 1;
  624.       HelpContext := 0;
  625.       Options := Options + [ofPathMustExist];
  626.  
  627.       if Execute then
  628.          begin
  629.             If Trim(Filename) <> '' Then
  630.                GetNewArchive := Filename
  631.             Else
  632.                GetNewArchive := '';
  633.          End
  634.       Else
  635.          GetNewArchive := ''
  636.    finally
  637.      Free
  638.    end;
  639.    TopMostOn;
  640.  
  641. End;
  642.  
  643. procedure TQuikZip.NewArchive;
  644. var
  645.    i : integer;
  646.    sResult : String;
  647. begin
  648.    sResult := GetNewArchive;
  649.    If Trim(sresult) <> '' then
  650.       begin
  651.          StrPCopy (g_cArchiveName, Trim(sResult));
  652.          ListArchiveContents;
  653.       end;
  654. end;
  655.  
  656. procedure TQuikZip.btnNewClick(Sender: TObject);
  657. begin
  658.    NewArchive;
  659. end;
  660.  
  661. procedure TQuikZip.mnuArchiveNewClick(Sender: TObject);
  662. begin
  663.    NewArchive;
  664. end;
  665.  
  666. procedure TQuikZip.mnuPopupPopup(Sender: TObject);
  667. begin
  668.    If (lstArchive.Items.Count > 0) Then
  669.       mnuPopupSelectAll.Enabled := True
  670.    else
  671.       mnuPopupSelectAll.Enabled := False;
  672.  
  673.    If (lstArchive.SelCount > 0) Then
  674.       begin
  675.          mnuPopupExtract.Enabled := True;
  676.          mnuPopupDelete.Enabled := True;
  677.          mnuPopupView.Enabled := True;
  678.          mnuPopupDeselectAll.Enabled := True;
  679.          mnuPopupInvert.Enabled := True;
  680.       end
  681.    else
  682.       begin
  683.          mnuPopupExtract.Enabled := False;
  684.          mnuPopupDelete.Enabled := False;
  685.          mnuPopupView.Enabled := False;
  686.          mnuPopupDeselectAll.Enabled := False;
  687.          mnuPopupInvert.Enabled := False;
  688.       end;
  689.  
  690. end;
  691.  
  692. procedure TQuikZip.mnuPopupSelectAllClick(Sender: TObject);
  693. var
  694.    i : Longint;
  695. begin
  696.    i := SendMessage(lstArchive.handle, LB_SELITEMRANGE, 1, MAKELONG(0 ,lstArchive.Items.Count -1));
  697. end;
  698.  
  699. procedure TQuikZip.mnuPopupDeselectAllClick(Sender: TObject);
  700. var
  701.    i : Longint;
  702. begin
  703.    i := SendMessage(lstArchive.handle, LB_SELITEMRANGE, 0, MAKELONG(0 ,lstArchive.Items.Count -1));
  704. end;
  705.  
  706. procedure TQuikZip.mnuPopupInvertClick(Sender: TObject);
  707. var
  708.    i : integer;
  709. begin
  710.    For I := 0 To (lstArchive.Items.Count - 1) do
  711.        lstArchive.Selected[I] := Not lstArchive.Selected[I];
  712. end;
  713.  
  714. procedure TQuikZip.mnuOptionsOnTopClick(Sender: TObject);
  715. begin
  716.     mnuOptionsOnTop.Checked := Not mnuOptionsOnTop.Checked;
  717.  
  718.     If mnuOptionsOnTop.Checked = True Then
  719.        SetWindowPos(QuikZip.Handle, HWND_TOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE))
  720.     Else
  721.        SetWindowPos(QuikZip.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
  722. end;
  723.  
  724. procedure TQuikZip.ProcessDroppedFiles(var MSG: Tmessage);
  725. var
  726.    I, iResult, iDotPos  : Integer;
  727.    {$IFDEF WIN32}
  728.    FileCount, wDrop : Integer;
  729.    {$ELSE}
  730.    FileCount, wDrop : Word;
  731.    {$ENDIF}
  732.    pFilename : PChar;
  733.    sTemp : String;
  734.    sExtension : String[4];
  735. Begin
  736.    pFileName := StrAlloc(g_iPathLen);
  737.  
  738.    {Retrieve the handle to the internal dropfiles structure}
  739.    wDrop := Msg.wParam;
  740.  
  741.    {Get the number of files}
  742.    {$IFDEF WIN32}
  743.    FileCount := DragQueryFile(wDrop, $FFFFFFFF, nil, 0);
  744.    {$ELSE}
  745.    FileCount := DragQueryFile(wDrop, $FFFF, nil, 0);
  746.    {$ENDIF}
  747.    For I := 0 To (FileCount - 1) do
  748.       begin
  749.          iResult := DragQueryFile(wDrop, I, pFilename, g_iPathLen);
  750.          If Copy(sTemp, Length(Trim(StrPas(pFilename))), 1) = '\' Then
  751.             StrCat(pFilename, '*.*');
  752.          {Make sure there is a '.' in the file name}
  753.          iDotPos := Pos('.', StrPas(pFilename));
  754.          If (iDotPos > 0) Then
  755.             begin
  756.                sExtension := ExtractFileExt(StrPas(pFilename));
  757.                If (FileCount = 1) And (LowerCase(sExtension) = '.zip') Then
  758.                   StrCopy(g_cArchiveName, pFilename)
  759.                Else
  760.                   AddFilesToArchive(pFilename);
  761.             end
  762.       end;
  763.    { Dispose of the wDrop structure}
  764.    DragFinish(wDrop);
  765.    ListArchiveContents;
  766.    StrDispose(pFileName);
  767.    inherited;
  768. end;
  769.  
  770. procedure TQuikZip.FormCreate(Sender: TObject);
  771. begin
  772.    DragAcceptFiles(Handle, True);
  773. end;
  774.  
  775. procedure TQuikZip.WMGetMinMaxInfo(var MSG: Tmessage);
  776. Begin
  777.    inherited;
  778.    with PMinMaxInfo(MSG.lparam)^ do
  779.    begin
  780.      with ptMinTrackSize do
  781.      begin
  782.        X := 560;
  783.        Y := 330;
  784.      end;
  785.    end;
  786. end;
  787.  
  788. procedure TQuikZip.DeleteFilesFromArchive;
  789. var
  790.    I, J, Button : Integer;
  791.    cMessage, cFilename : String;
  792.    pMessage, pFilename : PChar;
  793. begin
  794.    pMessage := StrAlloc(120);
  795.    pFileName := StrAlloc(g_iPathLen);
  796.    cMessage := 'Do you want to delete the ';
  797.    cMessage := cMessage + IntToStr(lstArchive.SelCount);
  798.    cMessage := cMessage + ' selected files from ';
  799.    cMessage := cMessage + StrPas(g_cArchiveName) + '?';
  800.    StrPCopy(pMessage, cMessage);
  801.    TopMostOff;
  802.    Button := Application.MessageBox(pMessage, 'Confirm', MB_YESNO + MB_ICONQUESTION +
  803.     mb_DefButton1);
  804.    if Button = IDYES then
  805.       begin
  806.          Screen.Cursor := crHourglass;
  807.          For J := 0 To (lstArchive.Items.Count - 1) do
  808.             If (lstArchive.Selected[J] <> False) Then
  809.                begin
  810.                   I := addZIP_ArchiveName(g_cArchiveName);
  811.                   cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
  812.                   If (cFilename <> '') Then cFilename := cFilename + '/';
  813.                   cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
  814.                   StrPCopy(pFileName, cFileName);
  815.                   I := addZIP_Include(pFilename);
  816.                   I := addZIP_Delete(True);
  817.                   I := addZIP;
  818.                End;
  819.          Screen.Cursor := crDefault;
  820.       End;
  821.    TopMostOn;
  822.    ListArchiveContents;
  823.    StrDispose(pMessage);
  824.    StrDispose(pFileName);
  825. end;
  826.  
  827. procedure TQuikZip.mnuPopupDeleteClick(Sender: TObject);
  828. begin
  829.    DeleteFilesFromArchive;
  830. end;
  831.  
  832. procedure TQuikZip.btnDeleteClick(Sender: TObject);
  833. begin
  834.    DeleteFilesFromArchive;
  835. end;
  836.  
  837. procedure TQuikZip.TopMostOn;
  838. begin
  839.    If mnuOptionsOnTop.Checked = True Then
  840.       SetWindowPos(QuikZip.Handle, HWND_TOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
  841. end;
  842.  
  843. procedure TQuikZip.TopMostOff;
  844. begin
  845.    If mnuOptionsOnTop.Checked = True Then
  846.       SetWindowPos(QuikZip.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
  847. end;
  848.  
  849. procedure TQuikZip.ExtractFilesFromArchive;
  850. var
  851.    I, J, Button : Integer;
  852.    cMessage, cFilename : String;
  853.    pMessage, pFilename, pExtractTo : PChar;
  854. begin
  855.    If lstArchive.SelCount > 0 then
  856.       begin
  857.          pMessage := StrAlloc(120);
  858.          pFileName := StrAlloc(g_iPathLen);
  859.          pExtractTo := StrAlloc(g_iPathLen);
  860.          cMessage := 'Do you want to extract the ';
  861.          cMessage := cMessage + IntToStr(lstArchive.SelCount);
  862.          cMessage := cMessage + ' selected files from ';
  863.          cMessage := cMessage + StrPas(g_cArchiveName) + '?';
  864.          StrPCopy(pMessage, cMessage);
  865.          TopMostOff;
  866.          Button := Application.MessageBox(pMessage, 'Confirm', MB_YESNO + MB_ICONQUESTION +
  867.           mb_DefButton1);
  868.          if Button = IDYES then
  869.             begin
  870.                Screen.Cursor := crHourglass;
  871.                For J := 0 To (lstArchive.Items.Count - 1) do
  872.                   If (lstArchive.Selected[J] <> False) Then
  873.                      begin
  874.                         I := addUNZIP_ArchiveName(g_cArchiveName);
  875.                         cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
  876.                         If (cFilename <> '') Then cFilename := cFilename + '/';
  877.                         cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
  878.                         StrPCopy(pFileName, cFileName);
  879.                         I := addUNZIP_Include(pFilename);
  880.                         StrPCopy(pExtractTo, g_cExtract);
  881.                         I := addUNZIP_ExtractTo(pExtractTo);
  882.                         I := addUNZIP;
  883.                      End;
  884.                Screen.Cursor := crDefault;
  885.             End;
  886.          TopMostOn;
  887.          StrDispose(pMessage);
  888.          StrDispose(pFileName);
  889.          StrDispose(pExtractTo);
  890.          Application.ProcessMessages;
  891.          UpdateStatusBar;
  892.       end;
  893. end;
  894.  
  895. procedure TQuikZip.mnuPopupExtractClick(Sender: TObject);
  896. begin
  897.    ExtractFilesFromArchive;
  898. end;
  899.  
  900. procedure TQuikZip.btnExtractClick(Sender: TObject);
  901. begin
  902.    ExtractFilesFromArchive;
  903. end;
  904.  
  905. procedure TQuikZip.ViewFiles;
  906. var
  907.    I, J, Button : Integer;
  908.    cFilename : String;
  909.    pFilename, pBuffer : PChar;
  910. begin
  911.    pFileName := StrAlloc(g_iPathLen);
  912.    pBuffer := StrAlloc(1000);
  913.    TopMostOff;
  914.    Screen.Cursor := crHourglass;
  915.    For J := 0 To (lstArchive.Items.Count - 1) do
  916.       If (lstArchive.Selected[J] <> False) Then
  917.          begin
  918.             I := addUNZIP_ArchiveName(g_cArchiveName);
  919.             cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
  920.             If (cFilename <> '') Then cFilename := cFilename + '/';
  921.             cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
  922.             StrPCopy(pFileName, cFileName);
  923.             I := addUNZIP_Include(pFilename);
  924.             I := addUNZIP_ToMemory(pBuffer, 1000);
  925.             I := addUNZIP;
  926.             Button := Application.MessageBox(pBuffer, 'Viewing', MB_OK + MB_ICONINFORMATION +
  927.                    mb_DefButton1);
  928.          End;
  929.    Screen.Cursor := crDefault;
  930.    TopMostOn;
  931.    StrDispose(pFileName);
  932.    StrDispose(pBuffer);
  933.    Application.ProcessMessages;
  934.    UpdateStatusBar;
  935. end;
  936.  
  937. procedure TQuikZip.mnuPopupViewClick(Sender: TObject);
  938. begin
  939.    ViewFiles;
  940. end;
  941.  
  942. procedure TQuikZip.btnViewClick(Sender: TObject);
  943. begin
  944.    ViewFiles;
  945. end;
  946.  
  947. {$IFDEF USE_CALLBACKS}
  948. function ProcessCallbackData(iLibrary, iMessage : Short; pInfo : PChar) : Integer;
  949.          {$IFDEF WIN32} stdcall; {$ENDIF}
  950. var
  951.    cAdditem, sMsg : String;
  952.    lSize : LongInt;
  953.    iWidth, iButton : Integer;
  954. begin
  955.     With QuikZip do
  956.        Case iMessage of
  957.             AM_SEARCHING : begin
  958.             {comment}
  959.             end;
  960.             AM_ZIPCOMMENT : begin
  961.             {comment}
  962.              end;
  963.             AM_ZIPPING : begin
  964.                 cAdditem := ' Zipping ' + ExtractFileName(GetCompFileName(StrPas(pInfo)));
  965.                 cAdditem := cAdditem + ' - ' + GetPercentComplete(StrPas(pInfo));
  966.                 pnlStatusBar.Caption := cAdditem;
  967.                 pnlStatusBar.Update;
  968.                 end;
  969.             AM_ZIPPED : begin
  970.                 cAdditem := ' ' + ExtractFileName(GetCompFileName(StrPas(pInfo))) + ' compressed';
  971.                 pnlStatusBar.Caption := cAdditem;
  972.                 pnlStatusBar.Update;
  973.                 end;
  974.             AM_UNZIPPING : begin
  975.                 cAdditem := ' Unzipping ' + ExtractFileName(GetCompFileName(StrPas(pInfo)));
  976.                 cAdditem := cAdditem + ' - ' + GetPercentComplete(StrPas(pInfo));
  977.                 pnlStatusBar.Caption := cAdditem;
  978.                 pnlStatusBar.Update;
  979.                 end;
  980.             AM_UNZIPPED : begin
  981.                 cAdditem := ' ' + ExtractFileName(GetCompFileName(StrPas(pInfo))) + ' uncompressed';
  982.                 pnlStatusBar.Caption := cAdditem;
  983.                 pnlStatusBar.Update;
  984.                 end;
  985.             AM_TESTING : begin
  986.                 cAdditem := ' Testing ' + ExtractFileName(GetCompFileName(StrPas(pInfo)));
  987.                 cAdditem := cAdditem + ' - ' + GetPercentComplete(StrPas(pInfo));
  988.                 pnlStatusBar.Caption := cAdditem;
  989.                 pnlStatusBar.Update;
  990.                 end;
  991.             AM_TESTED : begin
  992.                 cAdditem := ' ' + ExtractFileName(GetCompFileName(StrPas(pInfo))) + ' tested';
  993.                 pnlStatusBar.Caption := cAdditem;
  994.                 pnlStatusBar.Update;
  995.                 end;
  996.             AM_DELETING : begin
  997.                 cAdditem := ' Deleting ' + ExtractFileName(StrPas(pInfo));
  998.                 pnlStatusBar.Caption := cAdditem;
  999.                 pnlStatusBar.Update;
  1000.                 end;
  1001.             AM_DELETED : begin
  1002.                 cAdditem := ' ' + ExtractFileName(StrPas(pInfo)) + ' deleted';
  1003.                 pnlStatusBar.Caption := cAdditem;
  1004.                 pnlStatusBar.Update;
  1005.                 end;
  1006.             AM_DISKCHANGE : begin
  1007.                {comment}
  1008.                 end;
  1009.             AM_VIEW : begin
  1010.                 If Trim(GetViewFileName((StrPas(pInfo)))) <> '' then
  1011.                    begin
  1012.                       cAdditem := GetViewFileName((StrPas(pInfo))) + #9;
  1013.                       iWidth := Pos(#9, cAdditem);
  1014.                       If iWidth > g_iWidth then
  1015.                           begin
  1016.                              g_iWidth := iWidth;
  1017.                              hdrArchive.SectionWidth[0] := g_iWidth * 7
  1018.                           end;
  1019.                       lSize := GetFileOriginalSize((StrPas(pInfo)));
  1020.                       g_lSize := g_lSize + lSize;
  1021.                       cAdditem := cAdditem + GetFileDate((StrPas(pInfo))) + #9;
  1022.                       cAdditem := cAdditem + GetFileTime((StrPas(pInfo))) + #9;
  1023.                       cAdditem := cAdditem + IntToStr(lSize) + #9;
  1024.                       cAdditem := cAdditem + IntToStr(GetFileCompressedSize((StrPas(pInfo)))) + #9;
  1025.                       cAdditem := cAdditem + GetFileCompressionRatio((StrPas(pInfo))) + #9;
  1026.                       cAdditem := cAdditem + GetFilePath((StrPas(pInfo))) + #9;
  1027.                       lstArchive.Items.Add(cAdditem);
  1028.                       g_iCount := g_iCount + 1;
  1029.                    end;
  1030.                 end;
  1031.             AM_ERROR : begin
  1032.                {error}
  1033.                 end;
  1034.             AM_WARNING : begin
  1035.                {warning}
  1036.                 end;
  1037.             AM_QUERYOVERWRITE : begin
  1038.                 {Display message}
  1039.                 MessageBeep(MB_ICONQUESTION);
  1040.                 with TReplaceDlg.Create(Application) do
  1041.                 try
  1042.                    TopMostOff;
  1043.                    If iLibrary = azLIBRARY_ADDUNZIP then
  1044.                       lblOldFileName.Caption := GetPiece(StrPas(pInfo), '|', 2)
  1045.                    else
  1046.                       lblOldFileName.Caption := ExtractFileName(GetPiece(StrPas(pInfo), '|', 2));
  1047.                    sMsg := FormatFloat('###,###,##0', StrToInt(GetPiece(StrPas(pInfo), '|', 3))) + ' bytes ';
  1048.                    sMsg := sMsg + GetPiece(StrPas(pInfo), '|', 4) + ' ';
  1049.                    lblOldFileData.Caption := sMsg;
  1050.                    If iLibrary = azLIBRARY_ADDUNZIP then
  1051.                       lblNewFileName.Caption := ExtractFileName(GetPiece(StrPas(pInfo), '|', 5))
  1052.                    Else
  1053.                       lblNewFileName.Caption := GetPiece(StrPas(pInfo), '|', 5);
  1054.                    sMsg := FormatFloat('###,###,##0', StrToInt(GetPiece(StrPas(pInfo), '|', 6))) + ' bytes ';
  1055.                    sMsg := sMsg + GetPiece(StrPas(pInfo), '|', 7) + ' ';
  1056.                    lblNewFileData.Caption := sMsg;
  1057.                    iButton := ShowModal;
  1058.                 finally
  1059.                    TopMostOn;
  1060.                    Free;
  1061.                 end;
  1062.  
  1063.                 Case iButton of
  1064.                    mrOK : begin
  1065.                       ProcessCallbackData := azOW_YES;
  1066.                       end;
  1067.  
  1068.                    mrYES : begin
  1069.                       ProcessCallbackData := azOW_YES_TO_ALL;
  1070.                       end;
  1071.  
  1072.                    mrNO : begin
  1073.                       ProcessCallbackData := azOW_NO;
  1074.                       end;
  1075.  
  1076.                    mrCANCEL : begin
  1077.                       ProcessCallbackData := azOW_NO_TO_ALL;
  1078.                       end;
  1079.                    end;
  1080.                 end;
  1081.             AM_COPYING : begin
  1082.                 cAdditem := ' Copying file to ' + StrPas(g_cArchiveName);
  1083.                 pnlStatusBar.Caption := cAdditem;
  1084.                 pnlStatusBar.Update;
  1085.                 end;
  1086.             AM_COPIED : begin
  1087.                 cAdditem := ' File copied';
  1088.                 pnlStatusBar.Caption := cAdditem;
  1089.                 pnlStatusBar.Update;
  1090.                 end;
  1091.         end;
  1092. end;
  1093. {$ENDIF}
  1094.  
  1095. procedure TQuikZip.mnuSFXClick(Sender: TObject);
  1096. var
  1097.    i : integer;
  1098.    sResult : String;
  1099.    f : file;
  1100. begin
  1101.     i := addZIP_BuildSFX(True);
  1102.     i := addZIP;
  1103.     i := addZIP_BuildSFX(False);
  1104.     AssignFile(f, StrPas(g_cArchiveName));
  1105.     sResult := ChangeFileExt(StrPas(g_cArchiveName), '.EXE');
  1106.     StrPCopy(g_cArchiveName, sResult);
  1107.     Rename(f, sResult);
  1108.     ListArchiveContents;
  1109. end;
  1110.  
  1111. procedure TQuikZip.lstArchiveMeasureItem(Control: TWinControl;
  1112.   Index: Integer; var Height: Integer);
  1113. begin
  1114.    Height := (Control as TListBox).Canvas.TextHeight('W');
  1115. end;
  1116.  
  1117. end.
  1118.