Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZThrd;
  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. interface
  28.  
  29. uses
  30.   Classes, {ZipWrkr,} ZipMstr19, StdCtrls, SysUtils, Messages, Main9_1;
  31.  
  32.  
  33. type
  34.   TZipThread = class(TThread)
  35.   private
  36.         { Private declarations }
  37.         zip: TZipMaster19;
  38.         ftext: string;
  39.         fSpecs: TStrings;
  40.         fName: String;
  41.         fMemo: TMemo;
  42.   err: integer;
  43.   protected
  44.         procedure Execute; override;
  45.         procedure ShowText;
  46.   procedure ZipMessage(Sender: TObject; ErrCode: integer; const Message:
  47.       TZMString);
  48.         procedure CheckTerminate(Sender: TObject; var stop: boolean);
  49.         procedure Finished(Sender: TObject);
  50.   public
  51.         constructor Create(Filename: string; Specs: TStrings; Memo: TMemo; suspended: boolean);
  52.         destructor Destroy; override;      
  53.         procedure AfterConstruction; override;
  54.   end;
  55.  
  56. implementation
  57.  
  58. uses
  59.   ZMMsg19;
  60.  
  61. { Important: Methods and properties of objects in VCL or CLX can only be used
  62.   in a method called using Synchronize, for example,
  63.  
  64.       Synchronize(UpdateCaption);
  65.  
  66.   and UpdateCaption could look like,
  67.  
  68.     procedure TZipThread.UpdateCaption;
  69.     begin
  70.       Form1.Caption := 'Updated in a thread';
  71.     end; }
  72.  
  73. { TZipThread }
  74.  
  75. // runs own thread
  76. procedure TZipThread.Execute;
  77. begin
  78.   zip.Active := true;
  79.         zip.Add;
  80.   err := zip.ErrCode;
  81. end;
  82.  
  83. // must run main thread ie via Synchronize
  84. procedure TZipThread.ShowText;
  85. begin
  86.         fMemo.Lines.Add(fText);
  87. end;
  88.  
  89. procedure TZipThread.ZipMessage(Sender: TObject; ErrCode: integer; const
  90.     Message: TZMString);
  91. begin
  92.         if (ErrCode <> 0) and (ErrCode <> DZ_RES_MISS{767}) then   // ignore missing
  93.         begin
  94.                 fText := '('+IntToStr(ErrCode)+') '+Message;
  95.                 Synchronize(ShowText);          // in main thread add string to memo
  96.         end  {
  97.         else    // showing all messages will slow it down
  98.         begin
  99.                 fText := Message;
  100.                 Synchronize(ShowText);          // in main thread add string to memo
  101.         end }
  102.         ;
  103. end;
  104.  
  105. destructor TZipThread.Destroy;
  106. begin
  107.         zip.Free;
  108.   inherited Destroy;
  109. end;
  110.  
  111. // stops calls to ProcessMessages & checks for Terminated
  112. procedure TZipThread.CheckTerminate(Sender: TObject; var stop: boolean);
  113. begin
  114.         if Terminated then
  115.                 stop := true;
  116. end;
  117.  
  118. constructor TZipThread.Create(Filename: string; Specs: TStrings; Memo: TMemo; suspended: boolean);
  119. begin
  120.         inherited Create(suspended);
  121.         fName := Filename;
  122.         fSpecs := Specs;
  123.         fMemo := Memo;
  124.         zip := TZipMaster19.Create(nil);        // no owner, so must free
  125.   zip.Active := false;
  126.   zip.NotMainThread := true;
  127.         OnTerminate := Finished;
  128. end;
  129.  
  130. procedure TZipThread.AfterConstruction;
  131. begin
  132.         zip.OnCheckTerminate := CheckTerminate;
  133.         zip.OnMessage := ZipMessage;
  134.         zip.Unattended := true;  
  135.         zip.ZipFileName := fName;
  136.         zip.FSpecArgs.Assign(fSpecs);
  137.   zip.DLLDirectory := '..\..\dll';
  138.         inherited;                                         
  139. end;
  140.  
  141. // runs main thread
  142. procedure TZipThread.Finished(Sender: TObject);
  143. begin
  144.         Form1.ZipThread := nil;                 // don't allow Cancel
  145.         fMemo.Lines.Add( 'Added '+IntToStr(zip.SuccessCnt)+' files');
  146.         if zip.ErrCode <> 0 then
  147.                 fMemo.Lines.Add( 'Error '+IntToStr(zip.ErrCode and $FFFF)+'  '+zip.ErrMessage);
  148. end;
  149.  
  150.  
  151. end.
  152.  
  153.