Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 1 | daniel-mar | 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 |