home *** CD-ROM | disk | FTP | other *** search
/ Hot Shareware 32 / hot34.iso / ficheros / 9ZIP / TSUZDLL.ZIP / EXAM3 / FUMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-07  |  22KB  |  810 lines
  1. //---------------------------------------------------------------------------
  2. //This is a main unit of example how to use TopSpeed Unzip DLL in Delphi
  3. //Compiled with Borland Delphi 3.0
  4. //(c) TopSpeedSoft, 1998
  5. //Be sure TSUZ.DLL is available in directory.
  6. //---------------------------------------------------------------------------
  7. unit fumain;
  8.  
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13.   Buttons, ExtCtrls, ComCtrls,ShellApi,
  14.   StdCtrls, checklst, FileCtrl, Grids;
  15.  
  16.  
  17. const
  18.   GColMax = 7;
  19.   GridHdr : array [0..GColMax] of shortstring =
  20.    ('  ','Name','Date','Time','Size','Ratio','Packed','Path');
  21.   GColWdt : array [0..GColMax] of integer =
  22.     (20,100,70,80,90,45,90,200);
  23.   GRightCol : array [0..GColMax] of boolean =
  24.     (false,false,false,false,true,true,true,false);
  25.  
  26. type
  27.   TForm1 = class(TForm)
  28.     Panel1: TPanel;
  29.     StatusBar1: TStatusBar;
  30.     DrawGrid1: TDrawGrid;
  31.     GroupBox2: TGroupBox;
  32.     GroupBox3: TGroupBox;
  33.     sbOpen: TSpeedButton;
  34.     sbAdd: TSpeedButton;
  35.     sbRng: TSpeedButton;
  36.     sbExtract: TSpeedButton;
  37.     sbHelp: TSpeedButton;
  38.     OpenZipDlg: TOpenDialog;
  39.     sbClose: TSpeedButton;
  40.     procedure ExecFile;
  41.     procedure InvDrwGrd;
  42.     procedure sbOpenClick(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure LoadGrid;
  45.     procedure EmptyGrid;
  46.     procedure FormDestroy(Sender: TObject);
  47.     procedure DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
  48.       Rect: TRect; State: TGridDrawState);
  49.     procedure DrawGrid1DblClick(Sender: TObject);
  50.     procedure DrawGrid1SelectCell(Sender: TObject; Col, Row: Integer;
  51.       var CanSelect: Boolean);
  52.     procedure DrawGrid1KeyDown(Sender: TObject; var Key: Word;
  53.       Shift: TShiftState);
  54.     procedure DrawGrid1KeyUp(Sender: TObject; var Key: Word;
  55.       Shift: TShiftState);
  56.     procedure sbExtractClick(Sender: TObject);
  57.     procedure sbHelpClick(Sender: TObject);
  58.     procedure sbCloseClick(Sender: TObject);
  59.   private
  60.     { Private declarations }
  61.   public
  62.     { Public declarations }
  63.   end;
  64.  
  65.  
  66.  
  67. //API of TopSpeed Unzip Dll for Windows 95
  68.  
  69. function zOpenZipFile(zipfilename:PChar): integer; stdcall;
  70. function zCloseZipFile: integer; stdcall;
  71. function zGetTotalFiles : integer; stdcall;
  72. function zGetTotalBytes : integer; stdcall;
  73. function zGetSelectedFiles : integer; stdcall;
  74. function zGetSelectedBytes : integer; stdcall;
  75. function zGetLastErrorAsText : pchar; stdcall;
  76. function zGetSkipedFiles: integer; stdcall;
  77. function zGetRunTimeInfo(var ProcessedFiles,ProcessedBytes : integer) : boolean; stdcall;
  78. function zCancelOperation : boolean; stdcall;
  79.  
  80. function zExtractOne(ItemNo: integer;ExtractDirectory,Password: pchar;
  81.   OverwriteExisting,UseFolders,TestOnly : boolean;RTInfoFunc: pointer) : integer; stdcall;
  82. function zExtractSelected(ExtractDirectory,Password: pchar;
  83.   OverwriteExisting,UseFolders,TestOnly : boolean;RTInfoFunc: pointer) : integer; stdcall;
  84. function zExtractAll(ExtractDirectory,Password: pchar;
  85.   OverwriteExisting,UseFolders,TestOnly : boolean;RTInfoFunc: pointer) : integer; stdcall;
  86.  
  87. function zGetFileName(i : integer) : pchar; stdcall;
  88. function zGetFileExt(i : integer) : pchar; stdcall;
  89. function zGetFilePath(i : integer) : pchar; stdcall;
  90. function zGetFileDate(i : integer) : integer; stdcall;
  91. function zGetFileTime(i : integer) : integer; stdcall;
  92. function zGetFileSize(i : integer) : integer; stdcall;
  93. function zGetCompressedFileSize(i : integer) : integer; stdcall;
  94. function zFileIsEncrypted(i : integer) : boolean; stdcall;
  95. function zGetLastOperResult(i : integer) : pchar; stdcall;
  96.  
  97. function zFileIsSelected(i : integer) : boolean; stdcall;
  98. function zSelectFile(i: integer;how : boolean): boolean; stdcall;
  99.  
  100.  
  101.  
  102. var
  103.   Form1: TForm1;
  104.   zipfilename, tempdir : string;
  105.   begtime,endtime : integer;
  106.   reqbytes, lsr : integer;
  107.   onlymove : boolean;
  108.   ImgList : TImageList;
  109.   ImgInd, FFDel : TStringList;
  110.   ProcRep: TStringList;
  111.  
  112. implementation
  113.  
  114. uses ExtrOpt, About, PgsInd, Report;
  115.  
  116. {$R *.DFM}
  117.  
  118.  
  119. function zOpenZipFile;external  'tsuz.dll' name 'zOpenZipFile';
  120. function zCloseZipFile;external  'tsuz.dll' name 'zCloseZipFile';
  121. function zGetTotalFiles;external  'tsuz.dll' name 'zGetTotalFiles';
  122. function zGetTotalBytes;external  'tsuz.dll' name 'zGetTotalBytes';
  123. function zGetSelectedFiles;external  'tsuz.dll' name 'zGetSelectedFiles';
  124. function zGetSelectedBytes;external  'tsuz.dll' name 'zGetSelectedBytes';
  125. function zGetLastErrorAsText;external  'tsuz.dll' name 'zGetLastErrorAsText';
  126. function zGetSkipedFiles;external  'tsuz.dll' name 'zGetSkipedFiles';
  127. function zGetRunTimeInfo;external  'tsuz.dll' name 'zGetRunTimeInfo';
  128. function zCancelOperation;external  'tsuz.dll' name 'zCancelOperation';
  129.  
  130. function zExtractOne;external  'tsuz.dll' name 'zExtractOne';
  131. function zExtractSelected;external  'tsuz.dll' name 'zExtractSelected';
  132. function zExtractAll;external  'tsuz.dll' name 'zExtractAll';
  133.  
  134. function zGetFileName;external  'tsuz.dll' name 'zGetFileName';
  135. function zGetFileExt;external  'tsuz.dll' name 'zGetFileExt';
  136. function zGetFilePath;external  'tsuz.dll' name 'zGetFilePath';
  137. function zGetFileDate;external  'tsuz.dll' name 'zGetFileDate';
  138. function zGetFileTime;external  'tsuz.dll' name 'zGetFileTime';
  139. function zGetFileSize;external  'tsuz.dll' name 'zGetFileSize';
  140. function zGetCompressedFileSize;external  'tsuz.dll' name 'zGetCompressedFileSize';
  141. function zFileIsEncrypted;external  'tsuz.dll' name 'zFileIsEncrypted';
  142. function zGetLastOperResult;external  'tsuz.dll' name 'zGetLastOperResult';
  143.  
  144. function zFileIsSelected;external  'tsuz.dll' name 'zFileIsSelected';
  145. function zSelectFile;external  'tsuz.dll' name 'zSelectFile';
  146.  
  147.  
  148.  
  149. function RightStr(v: integer) : string;
  150. var
  151.   s1,s2 : string;
  152.   i,j,k : integer;
  153. begin
  154.   s2 := '                              ';
  155.   k := 30;
  156.   s1 := IntToStr(v);
  157.   i := length(s1);
  158.   j := 3;
  159.   while i > 0 do
  160.   begin
  161.     if j = 0 then begin
  162.       s2[k] := ',';
  163.       j := 3;
  164.       dec(k);
  165.     end;
  166.     s2[k] := s1[i];
  167.     dec(i); dec(j); dec(k);
  168.   end;
  169.   Result := copy(s2,k+1,30);
  170. end;
  171.  
  172.  
  173.  
  174. procedure TForm1.LoadGrid;
  175. begin
  176.   with DrawGrid1 do
  177.   begin
  178.     RowCount := zGetTotalFiles + 1;
  179.     FixedRows := 1;
  180.     TopRow := 1;
  181.     RowHeights[0] := 20;
  182.   end;
  183.   lsr := -1;
  184.   StatusBar1.Panels[0].Text := 'Total: ' + RightStr(zGetTotalFiles)+ ' files  -  '
  185.     +RightStr(zGetTotalBytes)+ ' bytes';
  186.   StatusBar1.Panels[1].Text := 'Selected: 0 files';
  187.   sbExtract.Enabled := true;
  188.   sbAdd.Enabled := true;
  189.   sbRng.Enabled := true;
  190. end;
  191.  
  192. procedure TForm1.EmptyGrid;
  193. begin
  194.   DrawGrid1.FixedRows := 0;
  195.   DrawGrid1.RowCount := 1;
  196.   DrawGrid1.Refresh;
  197.   StatusBar1.Panels[0].Text := 'Total: 0 files';
  198.   StatusBar1.Panels[1].Text := 'Selected: 0 files';
  199.   sbExtract.Enabled := false;
  200.   sbAdd.Enabled := false;
  201.   sbRng.Enabled := false;
  202. end;
  203.  
  204.  
  205.  
  206. procedure TForm1.FormCreate(Sender: TObject);
  207. var
  208.   i: integer;
  209.   SysIL: uint;
  210.   SFI: TSHFileInfo;
  211.   ps : string;
  212.   pc : array [0..255] of char;
  213. begin
  214.   with DrawGrid1 do
  215.   begin
  216.     DefaultRowHeight := 16;
  217.     RowHeights[0] := 20;
  218.     ColCount := GColMax+1;
  219.     for i := 0 to GColMax do
  220.       ColWidths[i] := GColWdt[i];
  221.   end;
  222.   EmptyGrid;
  223.  
  224.   GetTempPath(sizeof(pc),pc);
  225.   tempdir := StrPas(pc);
  226.   onlymove := false;
  227.   ProcRep := TStringList.Create;
  228.   ImgInd := TStringList.Create;
  229.   FFDel := TStringList.Create;
  230.   FFDel.Duplicates := dupIgnore;
  231.   FFDel.Sorted := false;
  232.   FFDel.Add(tempdir+'$$report.txt');
  233.  
  234.   ImgList := TImageList.Create(self);
  235.   SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  236.   if SysIL <> 0 then begin
  237.     ImgList.Handle := SysIL;
  238.     ImgList.ShareImages := TRUE;  // DON'T FREE THE SYSTEM IMAGE LIST!!!!!  BAD IDEA (tm)!
  239.   end;
  240.  
  241.   ps := ParamStr(1);
  242.   if length(ps) > 0 then
  243.   begin
  244.     if zOpenZipFile(PChar(ps)) <> 0 then
  245.       MessageDlg('ERROR! '+zGetLastErrorAsText,mtError,[mbOk],0)
  246.     else
  247.     begin
  248.       EmptyGrid;
  249.       LoadGrid;
  250.     end;
  251.   end;
  252. end;
  253.  
  254. procedure TForm1.FormDestroy(Sender: TObject);
  255. var
  256.   i : integer;
  257. begin
  258.   ImgList.Free;
  259.   with FFDel do
  260.   begin
  261.     if count > 0 then
  262.       for i := 0 to count - 1 do
  263.         deletefile(strings[i]);
  264.   end;
  265.   FFDel.Free;
  266.   ProcRep.Free;
  267.   ImgInd.Free;
  268. end;
  269.  
  270.  
  271.  
  272. procedure TForm1.sbOpenClick(Sender: TObject);
  273. begin
  274.   OpenZipDlg.InitialDir := ExtractFileDir(OpenZipDlg.FileName);
  275.   if not OpenZipDlg.Execute then
  276.     exit;
  277.   zipfilename := OpenZipDlg.FileName;
  278.   if zOpenZipFile(PChar(zipfilename)) <> 0 then
  279.     MessageDlg('ERROR! '+zGetLastErrorAsText,mtError,[mbOk],0)
  280.   else
  281.   begin
  282.     EmptyGrid;
  283.     LoadGrid;
  284.   end;
  285. end;
  286.  
  287.  
  288.  
  289. function Date2Str(dd: word): string;
  290. var
  291.   w : word;
  292.   s1,s2 : string;
  293. begin
  294.   s1 := '';
  295.   w := (dd shr 5) and $f;
  296.   if w < 10 then
  297.     s1 := s1 + '0' + IntToStr(w) + '/'
  298.   else
  299.     s1 := s1 + IntToStr(w) + '/';
  300.  
  301.   w := dd and $1f;
  302.   if w < 10 then
  303.     s1 := s1 + '0' + IntToStr(w) + '/'
  304.   else
  305.     s1 := s1 + IntToStr(w) + '/';
  306.  
  307.   w := (dd shr 9) and $7f;
  308.   s2 := IntToStr(1980+w);
  309.   s1 := s1 + copy(s2,3,2);
  310.   result := s1;
  311. end;
  312.  
  313.  
  314. function Time2Str(dd: word): string;
  315. var
  316.   w : word;
  317.   s1 : string;
  318. begin
  319.   s1 := '';
  320.   w := (dd shr 11) and $1f;
  321.   if w < 10 then
  322.     s1 := s1 + '0' + IntToStr(w) + ':'
  323.   else
  324.     s1 := s1 + IntToStr(w) + ':';
  325.  
  326.   w := (dd shr 5) and $3f;
  327.   if w < 10 then
  328.     s1 := s1 + '0' + IntToStr(w) + ':'
  329.   else
  330.     s1 := s1 + IntToStr(w) + ':';
  331.  
  332.   w := (dd and $1f) * 2;
  333.   if w < 10 then
  334.     s1 := s1 + '0' + IntToStr(w)
  335.   else
  336.     s1 := s1 + IntToStr(w);
  337.   result := s1;
  338. end;
  339.  
  340.  
  341. procedure GetRowTxt(col,row : integer;var txt: string;
  342.   var slc: boolean);
  343. begin
  344.   txt := '';
  345.   slc := zFileIsSelected(row-1);
  346.   case col of
  347.       1 : begin
  348.             txt := zGetFileName(row-1);
  349.             if zFileIsEncrypted(row-1) then txt := txt + '+';
  350.           end;
  351.       2 : txt := Date2Str(zGetFileDate(row-1));
  352.       3 : txt := Time2Str(zGetFileTime(row-1));
  353.       4 : txt := RightStr(zGetFileSize(row-1));
  354.       5 : if zGetFileSize(row-1) = 0 then txt := '0' else
  355.             txt := IntToStr(round(zGetCompressedFileSize(row-1)*100/zGetFileSize(row-1)))+'%';
  356.       6 : txt := RightStr(zGetCompressedFileSize(row-1));
  357.       7 : txt := zGetFilePath(row-1);
  358.   end;
  359. end;
  360.  
  361.  
  362. function GetIconIndex(row : integer): integer;
  363. var
  364.   SFI: TSHFileInfo;
  365.   s : string;
  366. begin
  367.   if zGetFileName(row-1) = PChar('[FOLDER]') then
  368.   begin
  369.     s := ImgInd.Values['FOLDER'];
  370.     if length(s) = 0 then
  371.     begin
  372.       SHGetFileInfo(zGetFileName(row-1), FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY, SFI,
  373.         SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  374.       ImgInd.Values['FOLDER'] := IntToStr(SFI.iIcon);
  375.       Result := SFI.iIcon;
  376.     end
  377.     else
  378.       Result := StrToInt(s);
  379.   end
  380.   else
  381.   begin
  382.     s := ImgInd.Values[zGetFileExt(row-1)];
  383.     if length(s) = 0 then
  384.     begin
  385.       SHGetFileInfo(zGetFileName(row-1), FILE_ATTRIBUTE_NORMAL, SFI,
  386.         SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  387.       ImgInd.Values[zGetFileExt(row-1)] := IntToStr(SFI.iIcon);
  388.       Result := SFI.iIcon;
  389.     end
  390.     else
  391.       Result := StrToInt(s);
  392.   end;
  393. end;
  394.  
  395.  
  396.  
  397. procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
  398.   Rect: TRect; State: TGridDrawState);
  399. var
  400.   x : integer;
  401.   txt : string;
  402.   slc : boolean;
  403. begin
  404.   with DrawGrid1.Canvas do
  405.   begin
  406.     if row = 0 then
  407.     begin
  408.       Font := Self.Font;
  409.       Brush := Self.Brush;
  410.       Font.Style := [fsBold];
  411.       Font.Color := clBlack;
  412.       txt := GridHdr[Col];
  413.       Pen.Color := clBlack;
  414.       Pen.Style := psSolid;
  415.       Rectangle(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
  416.       TextOut(Rect.Left+2,Rect.Top+1,txt);
  417.     end
  418.     else
  419.     begin
  420.       Font := Self.Font;
  421.       Brush := Self.Brush;
  422.  
  423.       GetRowTxt(Col,Row,txt,slc);
  424.       if slc then
  425.       begin
  426.         Brush.Color := clBlue;
  427.         Font.Color := clHighLightText;
  428.       end
  429.       else
  430.         Brush.Color := clWhite;
  431.       FillRect(Rect);
  432.  
  433.       if col <> 0 then
  434.       begin
  435.         if GRightCol[Col] then
  436.           x := Rect.Left + Rect.Right-Rect.Left-TextWidth(txt)-3
  437.         else
  438.           x := Rect.Left + 2;
  439.         TextOut(x,Rect.Top,txt);
  440.       end
  441.       else
  442.       begin
  443.         x := GetIconIndex(row);
  444.         ImgList.Draw(DrawGrid1.Canvas,Rect.Left,Rect.Top,x);
  445.       end;
  446.  
  447.       if DrawGrid1.Selection.Top = row then
  448.       begin
  449.         Pen.Color := clBlue;
  450.         MoveTo(Rect.Left,Rect.Top);
  451.         LineTo(Rect.Right,Rect.Top);
  452.         MoveTo(Rect.Left,Rect.Bottom-1);
  453.         LineTo(Rect.Right,Rect.Bottom-1);
  454.         if col = 0 then
  455.         begin
  456.           MoveTo(Rect.Left,Rect.Top);
  457.           LineTo(Rect.Left,Rect.Bottom);
  458.         end;
  459.         if col = GColMax then
  460.         begin
  461.           MoveTo(Rect.Right-1,Rect.Top);
  462.           LineTo(Rect.Right-1,Rect.Bottom);
  463.         end;
  464.       end;
  465.     end;
  466.   end;
  467. end;
  468.  
  469.  
  470.  
  471. procedure TForm1.ExecFile;
  472. var
  473.   efn : string;
  474.   r : integer;
  475. begin
  476.   if zGetTotalFiles < 1 then exit;
  477.   efn := zGetFileName(DrawGrid1.row-1);
  478.   if efn = '[FOLDER]' then begin
  479.     ShowMessage('There is nothing to do with folder');
  480.     exit;
  481.   end;
  482.   r := zExtractOne(DrawGrid1.row-1,PChar(tempdir),'',true,false,false,nil);
  483.   if r <> 0 then
  484.     MessageDlg('ERROR! '+zGetLastErrorAsText,mtError,[mbOk],0)
  485.   else
  486.   begin
  487.     ShellExecute(0,nil,PChar(tempdir+efn),nil,nil,SW_SHOW);
  488.     FFDel.Add(tempdir+efn);
  489.   end;
  490. end;
  491.  
  492.  
  493. procedure TForm1.DrawGrid1DblClick(Sender: TObject);
  494. begin
  495.   ExecFile;
  496. end;
  497.  
  498.  
  499. procedure TForm1.InvDrwGrd;
  500. var
  501.   Rect: TRect;
  502. begin
  503.   with DrawGrid1 do
  504.   begin
  505.     Rect.TopLeft := CellRect(LeftCol,TopRow).TopLeft;
  506.     Rect.BottomRight := ClientRect.BottomRight;
  507.     InvalidateRect(Handle,@Rect,false);
  508.   end;
  509. end;
  510.  
  511.  
  512.  
  513.  
  514. procedure TForm1.DrawGrid1SelectCell(Sender: TObject; Col, Row: Integer;
  515.   var CanSelect: Boolean);
  516. var
  517.   i, i1, i2 : integer;
  518.   rngsel : boolean;
  519.  
  520. begin
  521.   canselect := true;
  522.   if row < 1 then exit;
  523.  
  524.   if onlymove then
  525.   begin
  526.     onlymove := false;
  527.     InvDrwGrd;
  528.     exit;
  529.   end;
  530.  
  531.   if (not sbAdd.Down) and (not sbRng.Down) then
  532.   begin
  533.     if (zGetSelectedFiles = 1) and (lsr <> row-1) then
  534.       zSelectFile(lsr,not zFileIsSelected(lsr))
  535.     else
  536.       if zGetSelectedFiles > 1 then
  537.         for i := 0 to zGetTotalFiles-1 do
  538.           zSelectFile(i,false);
  539.   end;
  540.  
  541.   if sbRng.Down and (zGetSelectedFiles > 0) then
  542.   begin
  543.     rngsel := not zFileIsSelected(row-1);
  544.     if lsr < row-1 then begin
  545.       i1 := lsr; i2 := row-1; end
  546.     else begin
  547.       i1 := row-1; i2 := lsr; end;
  548.  
  549.     for i := i1 to i2 do
  550.       zSelectFile(i,rngsel);
  551.   end
  552.   else
  553.     zSelectFile(row-1,not zFileIsSelected(row-1));
  554.  
  555.   lsr := row-1;
  556.   StatusBar1.Panels[1].Text := 'Selected: ' + RightStr(zGetSelectedFiles)+ ' files  -  '
  557.     +RightStr(zGetSelectedBytes)+ ' bytes';
  558.   InvDrwGrd;
  559. end;
  560.  
  561.  
  562.  
  563. procedure TForm1.DrawGrid1KeyDown(Sender: TObject; var Key: Word;
  564.   Shift: TShiftState);
  565. begin
  566.   if DrawGrid1.rowcount < 2 then exit;
  567.   case key of
  568.     17: sbAdd.Down := true;
  569.     16: sbRng.Down := true;
  570.     32:   with DrawGrid1 do
  571.           begin
  572.             if col > leftcol then
  573.               col := col - 1
  574.             else
  575.               col := col + 1;
  576.           end;
  577.     40:   with DrawGrid1 do
  578.             if row < rowcount-1 then begin
  579.               onlymove := true;
  580.               row := row + 1;
  581.             end;
  582.     38:   with DrawGrid1 do
  583.             if row > 1 then begin
  584.               onlymove := true;
  585.               row := row - 1;
  586.             end;
  587.     37:   with DrawGrid1 do
  588.           begin
  589.             if LeftCol = 0 then
  590.               LeftCol := ColCount - 1
  591.             else
  592.               LeftCol := LeftCol - 1;
  593.             onlymove := true;
  594.             Col := LeftCol;
  595.           end;
  596.     39:   with DrawGrid1 do
  597.           begin
  598.             if LeftCol = ColCount - VisibleColCount then
  599.               LeftCol := 0
  600.             else
  601.               LeftCol := LeftCol + 1;
  602.             onlymove := true;
  603.             Col := LeftCol;
  604.           end;
  605.     36:   with DrawGrid1 do
  606.           begin
  607.             onlymove := true;
  608.             row := 1;
  609.           end;
  610.     35:   with DrawGrid1 do
  611.           begin
  612.             onlymove := true;
  613.             row := rowcount-1;
  614.           end;
  615.     33:   with DrawGrid1 do
  616.           begin
  617.             onlymove := true;
  618.             if row - VisibleRowCount < 1 then
  619.               row := 1
  620.             else
  621.               row := row - VisibleRowCount;
  622.           end;
  623.     34:   with DrawGrid1 do
  624.           begin
  625.             onlymove := true;
  626.             if row + VisibleRowCount > RowCount - 1 then
  627.               row := RowCount - 1
  628.             else
  629.               row := row + VisibleRowCount;
  630.           end;
  631.     13:   ExecFile;
  632.   end;
  633.   key := 0;
  634. end;
  635.  
  636. procedure TForm1.DrawGrid1KeyUp(Sender: TObject; var Key: Word;
  637.   Shift: TShiftState);
  638. begin
  639.   case key of
  640.     17: sbAdd.Down := false;
  641.     16: sbRng.Down := false;
  642.   end;
  643.   key := 0;
  644. end;
  645.  
  646.  
  647.  
  648. procedure ShowRTInfo;
  649. var
  650.   ii, pf, pb : integer;
  651.   msg: TMsg;
  652. begin
  653.   zGetRunTimeInfo(pf,pb);
  654.   if reqbytes > 0 then
  655.     ii := round(pb / reqbytes * 100)
  656.   else
  657.     ii := 0;
  658.  
  659.   with FPgsInd do
  660.   begin
  661.       stprocfiles.Caption := RightStr(pf);
  662.       stprocbytes.Caption := RightStr(pb);
  663.       PgsBar.Position := ii;
  664.       Update;
  665.     end;
  666.   if PeekMessage(msg,FPgsInd.PgsBtn.Handle,0,0,PM_REMOVE) then
  667.   begin
  668.     TranslateMessage(msg);
  669.     DispatchMessage(msg);
  670.   end;
  671. end;
  672.  
  673.  
  674.  
  675. procedure TForm1.sbExtractClick(Sender: TObject);
  676. var
  677.   testonly, wantrep : boolean;
  678.   msg,extrdir : string;
  679.   r, i, mr, pf, pb : integer;
  680. begin
  681.   with FExtrOpt do
  682.   begin
  683.     if zGetSelectedFiles = 0 then
  684.       rgFiles.ItemIndex := 0
  685.     else
  686.       rgFiles.ItemIndex := 1;
  687.  
  688.     mr := ShowModal;
  689.     if mr = mrCancel then
  690.     begin
  691.       exit;
  692.     end;
  693.     if ddDir.Items.Strings[0] <> ddDir.Text then
  694.       ddDir.Items.Insert(0,ddDir.Text);
  695.     extrdir := ddDir.Text;
  696.   end;
  697.  
  698.   if mr = mrYes then
  699.   begin
  700.     testonly := true;
  701.     FPgsInd.Caption := 'Testing ' + zipfilename;
  702.   end
  703.   else
  704.   begin
  705.     testonly := false;
  706.     FPgsInd.Caption := 'Extracting from ' + zipfilename;
  707.     if length(extrdir) > 0 then
  708.     begin
  709.       if extrdir[length(extrdir)] <> '\' then
  710.         extrdir := extrdir + '\';
  711.  
  712.       if not DirectoryExists(extrdir) then
  713.       begin
  714.         MessageDlg('ERROR! Directory '+ extrdir + ' does not exist!',
  715.         mtError,[mbOk],0);
  716.         exit;
  717.       end;
  718.     end;
  719.   end;
  720.  
  721.   begtime := GetTickCount;
  722.   if FExtrOpt.rgFiles.ItemIndex = 0 then
  723.   begin
  724.     reqbytes := zGetTotalBytes;
  725.     FPgsInd.stselfiles.Caption := 'Selected files: ' + RightStr(zGetTotalFiles);
  726.     FPgsInd.stselbytes.Caption := 'Selected bytes: ' + RightStr(reqbytes);
  727.     FPgsInd.Show;
  728.     r := zExtractAll(PChar(extrdir),PChar(FExtrOpt.edPswd.Text),FExtrOpt.cbOver.Checked,
  729.       FExtrOpt.cbUse.Checked,testonly,addr(ShowRTInfo));
  730.   end
  731.   else
  732.   begin
  733.     reqbytes := zGetSelectedBytes;
  734.     FPgsInd.stselfiles.Caption := 'Selected files: ' + RightStr(zGetSelectedFiles);
  735.     FPgsInd.stselbytes.Caption := 'Selected bytes: ' + RightStr(reqbytes);
  736.     FPgsInd.Show;
  737.     r := zExtractSelected(PChar(extrdir),PChar(FExtrOpt.edPswd.Text),FExtrOpt.cbOver.Checked,
  738.       FExtrOpt.cbUse.Checked,testonly,addr(ShowRTInfo));
  739.   end;
  740.   endtime := GetTickCount - begtime;
  741.   FPgsInd.Hide;
  742.   wantrep := false;
  743.   if r <> 0 then
  744.   begin
  745.     if MessageDlg('ERROR! '+ zGetLastErrorAsText +
  746.       #13' Would you like a report?',mtError,[mbYes,mbNo],0) = mrYes then
  747.         wantrep := true;
  748.   end
  749.   else
  750.   begin
  751.     if zGetSkipedFiles = 0 then
  752.       msg := 'All is Ok!  '
  753.     else
  754.       if zGetSkipedFiles = 1 then
  755.         msg := 'There is a skiped file!   '
  756.       else
  757.         msg := 'There are ' + IntToStr(zGetSkipedFiles) + ' skiped files!  ';
  758.     if MessageDlg(msg + '   Elapsed time ' + RightStr(endtime)+' ms'+
  759.       #13' Would you like a report?',mtInformation,[mbYes,mbNo],0) = mrYes then
  760.         wantrep := true;
  761.   end;
  762.   if wantrep then
  763.   begin
  764.     zGetRuntimeInfo(pf,pb);
  765.     mr := zGetTotalFiles - 1;
  766.     ProcRep.CLear;
  767.     if FExtrOpt.rgFiles.ItemIndex = 0 then
  768.     begin
  769.       for i := 0 to mr do
  770.       begin
  771.         ProcRep.Add(String(zGetFilePath(i))+String(zGetFileName(i))+' '+String(zGetLastOperResult(i)));
  772.         if ProcRep.Count >= pf then break;
  773.       end;
  774.     end
  775.     else
  776.     begin
  777.       for i := 0 to mr do
  778.         if zFileIsSelected(i) then
  779.         begin
  780.           ProcRep.Add(String(zGetFilePath(i))+String(zGetFileName(i))+' '+String(zGetLastOperResult(i)));
  781.           if ProcRep.Count >= pf then break;
  782.         end;
  783.     end;
  784.     ProcRep.Add('-----------------------------Total:');
  785.     ProcRep.Add('Processed files: ' + RightStr(pf));
  786.     ProcRep.Add('Processed bytes: ' + RightStr(pb));
  787.     ProcRep.Add('Skiped files: ' + RightStr(zGetSkipedFiles));
  788.     ProcRep.Add('Elapsed time: ' + RightStr(endtime)+' ms');
  789.  
  790.     ProcRep.SaveToFile(tempdir+'$$report.txt');
  791.     FReport.RichEdit1.Lines.LoadFromFile(tempdir+'$$report.txt');
  792.     FReport.ShowModal;
  793.   end;
  794. end;
  795.  
  796.  
  797. procedure TForm1.sbHelpClick(Sender: TObject);
  798. begin
  799.   FAbout.ShowModal;
  800. end;
  801.  
  802.  
  803. procedure TForm1.sbCloseClick(Sender: TObject);
  804. begin
  805.   zCloseZipFile;
  806.   EmptyGrid;
  807. end;
  808.  
  809. end.
  810.