1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Balázs Székely
22 Abstract:
23 Implementation of the package zipper class.
24 }
25 unit opkman_zipper;
26
27 {$mode objfpc}{$H+}
28
29 {$INCLUDE opkman_fpcdef.inc}
30
31 interface
32
33 uses
34 Classes, SysUtils, strutils,
35 // LazUtils
36 FileUtil, LazFileUtils,
37 // OpkMan
38 opkman_timer, opkman_serializablepackages, opkman_common,
39 {$IFDEF FPC311}zipper{$ELSE}opkman_zip{$ENDIF};
40
41 type
42 TOnProgressEx = procedure(Sender : TObject; const ATotPos, ATotSize: Int64);
43 TOnZipProgress = procedure(Sender: TObject; AZipfile: String; ACnt, ATotCnt: Integer; ACurPos, ACurSize, ATotPos, ATotSize: Int64;
44 AElapsed, ARemaining, ASpeed: LongInt) of object;
45 TOnZipError = procedure(Sender: TObject; APackageName: String; const AErrMsg: String) of object;
46 TOnZipCompleted = TNotifyEvent;
47
48 { TPackageUnzipper }
49
50 TPackageUnzipper = class(TThread)
51 private
52 FSrcDir: String;
53 FDstDir: String;
54 FStarted: Boolean;
55 FNeedToBreak: Boolean;
56 FZipFile: String;
57 FCnt: Integer;
58 FTotCnt: Integer;
59 FCurPos: Int64;
60 FCurSize: Int64;
61 FTotPos: Int64;
62 FTotPosTmp: Int64;
63 FTotSize: Int64;
64 FElapsed: Integer;
65 FRemaining: Integer;
66 FSpeed: Integer;
67 FErrMsg: String;
68 FIsUpdate: Boolean;
69 FTimer: TThreadTimer;
70 FUnZipper: TUnZipper;
71 FOnZipProgress: TOnZipProgress;
72 FOnZipError: TOnZipError;
73 FOnZipCompleted: TOnZipCompleted;
74 procedure DoOnTimer(Sender: TObject);
75 procedure DoOnProgressEx(Sender : TObject; const ATotPos, {%H-}ATotSize: Int64);
76 procedure DoOnZipProgress;
77 procedure DoOnZipError;
78 procedure DoOnZipCompleted;
GetZipSizenull79 function GetZipSize(var AIsDirZipped: Boolean; var ABaseDir: String): Int64;
80 protected
81 procedure Execute; override;
82 public
83 constructor Create;
84 destructor Destroy; override;
85 procedure StartUnZip(const ASrcDir, ADstDir: String; const AIsUpdate: Boolean = False);
86 procedure StopUnZip;
87 published
88 property OnZipProgress: TOnZipProgress read FOnZipProgress write FOnZipProgress;
89 property OnZipError: TOnZipError read FOnZipError write FOnZipError;
90 property OnZipCompleted: TOnZipCompleted read FOnZipCompleted write FOnZipCompleted;
91 end;
92
93 { TPackageZipper }
94
95 TPackageZipper = class(TThread)
96 private
97 FZipper: TZipper;
98 FSrcDir: String;
99 FZipFile: String;
100 FStarted: Boolean;
101 FNeedToBreak: Boolean;
102 FErrMsg: String;
103 FOnZipError: TOnZipError;
104 FOnZipCompleted: TOnZipCompleted;
105 procedure DoOnZipError;
106 procedure DoOnZipCompleted;
107 protected
108 procedure Execute; override;
109 public
110 constructor Create;
111 destructor Destroy; override;
112 procedure StartZip(const ASrcDir, AZipFile: String);
113 procedure StopZip;
114 published
115 property OnZipError: TOnZipError read FOnZipError write FOnZipError;
116 property OnZipCompleted: TOnZipCompleted read FOnZipCompleted write FOnZipCompleted;
117 end;
118
119 var
120 PackageUnzipper: TPackageUnzipper = nil;
121
122 implementation
123
124 { TPackageUnZipper }
125
126 procedure TPackageUnzipper.DoOnZipProgress;
127 begin
128 if Assigned(FOnZipProgress) then
129 FOnZipProgress(Self, FZipfile, FCnt, FTotCnt, FCurPos, FCurSize, FTotPosTmp, FTotSize, FElapsed, FRemaining, FSpeed);
130 end;
131
132 procedure TPackageUnzipper.DoOnZipError;
133 begin
134 if Assigned(FOnZipError) then
135 FOnZipError(Self, FZipFile, FErrMsg);
136 end;
137
138 procedure TPackageUnzipper.DoOnZipCompleted;
139 begin
140 if Assigned(FOnZipCompleted) then
141 FOnZipCompleted(Self);
142 end;
143
144 procedure TPackageUnzipper.Execute;
145 var
146 I: Integer;
147 DelDir: String;
148 begin
149 FCnt := 0;
150 for I := 0 to SerializablePackages.Count - 1 do
151 begin
152 if SerializablePackages.Items[I].IsExtractable then
153 begin
154 if FNeedToBreak then
155 Break;
156 Inc(FCnt);
157 FCurPos := 0;
158 FZipFile := SerializablePackages.Items[I].RepositoryFileName;
159 DelDir := FDstDir + SerializablePackages.Items[I].PackageBaseDir;
160 if FIsUpdate then
161 if DirectoryExists(DelDir) then
162 DeleteDirectory(DelDir, False);
163 try
164 FUnZipper.Clear;
165 FUnZipper.FileName := FSrcDir + SerializablePackages.Items[I].RepositoryFileName;
166 if SerializablePackages.Items[I].IsDirZipped then
167 FUnZipper.OutputPath := FDstDir
168 else
169 FUnZipper.OutputPath := FDstDir + SerializablePackages.Items[I].PackageBaseDir;
170 FUnZipper.OnProgressEx := @DoOnProgressEx;
171 FUnZipper.Examine;
172 FUnZipper.UnZipAllFiles;
173 SerializablePackages.Items[I].ChangePackageStates(ctAdd, psExtracted);
174 if (SerializablePackages.Items[I].IsDirZipped ) and (UpperCase(SerializablePackages.Items[I].PackageBaseDir) <> UpperCase(SerializablePackages.Items[I].ZippedBaseDir)) then
175 begin
176 CopyDirTree(FUnZipper.OutputPath + SerializablePackages.Items[I].ZippedBaseDir, DelDir, [cffOverwriteFile]);
177 DeleteDirectory(FUnZipper.OutputPath + SerializablePackages.Items[I].ZippedBaseDir, False);
178 end;
179 Synchronize(@DoOnZipProgress);
180 FTotPos := FTotPos + FCurSize;
181 except
182 on E: Exception do
183 begin
184 FErrMsg := E.Message;
185 SerializablePackages.Items[I].ChangePackageStates(ctRemove, psExtracted);
186 SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
187 DeleteDirectory(DelDir, False);
188 Synchronize(@DoOnZipError);
189 end;
190 end;
191 end;
192 end;
193 if (FNeedToBreak) then
194 DeleteDirectory(DelDir, False)
195 else
196 begin
197 SerializablePackages.MarkRuntimePackages;
198 Synchronize(@DoOnZipCompleted);
199 end;
200 end;
201
202 constructor TPackageUnzipper.Create;
203 begin
204 inherited Create(True);
205 FreeOnTerminate := True;
206 FUnZipper := TUnZipper.Create;
207 FTimer := nil;
208 end;
209
210 destructor TPackageUnzipper.Destroy;
211 begin
212 if FTimer.Enabled then
213 FTimer.StopTimer;
214 FTimer.Terminate;
215 FUnZipper.Free;
216 inherited Destroy;
217 end;
218
219 procedure TPackageUnzipper.DoOnTimer(Sender: TObject);
220 begin
221 Inc(FElapsed);
222 FSpeed := Round(FTotPosTmp/FElapsed);
223 FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
224 end;
225
226 procedure TPackageUnzipper.DoOnProgressEx(Sender : TObject; const ATotPos, ATotSize: Int64);
227 begin
228 FCurPos := ATotPos;
229 FCurSize := ATotSize;
230 FTotPosTmp := FTotPos + FCurPos;
231 Synchronize(@DoOnZipProgress);
232 Sleep(5);
233 end;
234
TPackageUnzipper.GetZipSizenull235 function TPackageUnzipper.GetZipSize(var AIsDirZipped: Boolean; var ABaseDir: String): Int64;
236 var
237 I: Integer;
238 Item: TFullZipFileEntry;
239 AllFiles: Boolean;
240 P: Integer;
241 begin
242 FUnZipper.Examine;
243 AllFiles := (FUnZipper.Files.Count = 0);
244 Result := 0;
245 if FUnZipper.Entries.Count > 0 then
246 begin
247 P := Pos('/', TZipFileEntry(FUnZipper.Entries.Items[0]).ArchiveFileName);
248 if P = 0 then
249 P := Pos('\', TZipFileEntry(FUnZipper.Entries.Items[0]).ArchiveFileName);
250 if P <> 0 then
251 ABaseDir := Copy(TZipFileEntry(FUnZipper.Entries.Items[0]).ArchiveFileName, 1, P);
252 end;
253 for I := 0 to FUnZipper.Entries.Count-1 do
254 begin
255 Item := FUnZipper.Entries[i];
256 if AllFiles or (FUnZipper.Files.IndexOf(Item.ArchiveFileName)<>-1) then
257 begin
258 Result := Result + TZipFileEntry(Item).Size;
259 if AIsDirZipped then
260 if Pos(ABaseDir, Item.ArchiveFileName) = 0 then
261 AIsDirZipped := False;
262 end;
263 end;
264 if not AIsDirZipped then
265 ABaseDir := ''
266 else
267 ABaseDir := Copy(ABaseDir, 1, Length(ABaseDir) - 1);
268 end;
269
270
271 procedure TPackageUnzipper.StartUnZip(const ASrcDir, ADstDir: String;
272 const AIsUpdate: Boolean);
273 var
274 I: Integer;
275 IsDirZipped: Boolean;
276 BaseDir: String;
277 begin
278 if FStarted then
279 Exit;
280 FDstDir := ADstDir;
281 FSrcDir := ASrcDir;
282 FTotCnt := 0;
283 FTotSize := 0;
284 FIsUpdate := AIsUpdate;
285 for I := 0 to SerializablePackages.Count - 1 do
286 begin
287 if SerializablePackages.Items[I].IsExtractable then
288 begin
289 try
290 FUnZipper.Clear;
291 FUnZipper.FileName := FSrcDir + SerializablePackages.Items[I].RepositoryFileName;
292 FUnZipper.Examine;
293 IsDirZipped := True;
294 BaseDir := '';
295 FTotSize := FTotSize + GetZipSize(IsDirZipped, BaseDir);
296 SerializablePackages.Items[I].IsDirZipped := IsDirZipped;
297 if BaseDir <> '' then
298 BaseDir := AppendPathDelim(BaseDir);
299 SerializablePackages.Items[I].ZippedBaseDir := BaseDir;
300 Inc(FTotCnt);
301 except
302 on E: Exception do
303 begin
304 FZipFile := SerializablePackages.Items[I].RepositoryFileName;
305 FErrMsg := E.Message;
306 Synchronize(@DoOnZipError);
307 end;
308 end
309 end;
310 end;
311 FStarted := True;
312 FTimer := TThreadTimer.Create;
313 FTimer.OnTimer := @DoOnTimer;
314 FTimer.StartTimer;
315 Start;
316 end;
317
318 procedure TPackageUnzipper.StopUnZip;
319 begin
320 if Assigned(FUnZipper) then
321 FUnZipper.Terminate;
322 if Assigned(FTimer) then
323 FTimer.StopTimer;
324 FNeedToBreak := True;
325 FStarted := False;
326 end;
327
328
329 { TPackageZipper }
330
331 procedure TPackageZipper.DoOnZipError;
332 begin
333 if Assigned(FOnZipError) then
334 FOnZipError(Self, FZipFile, FErrMsg);
335 end;
336
337 procedure TPackageZipper.DoOnZipCompleted;
338 begin
339 if Assigned(FOnZipCompleted) then
340 FOnZipCompleted(Self);
341 end;
342
343 procedure TPackageZipper.Execute;
344 var
345 PathEntry: String;
346 ZipFileEntries: TZipFileEntries;
347 FileList: TStringList;
348 SrcDir: String;
349 P, I: Integer;
350 CanGo: Boolean;
351 begin
352 CanGo := True;
353 FZipper.Filename := FZipFile;
354 SrcDir := FSrcDir;
355 FZipper.Clear;
356 ZipFileEntries := TZipFileEntries.Create(TZipFileEntry);
357 try
358 if DirPathExists(SrcDir) then
359 begin
360 P := RPos(PathDelim, ChompPathDelim(SrcDir));
361 PathEntry := LeftStr(SrcDir, P);
362 FileList := TStringList.Create;
363 try
364 FindAllFilesEx(SrcDir, FileList);
365 for I := 0 to FileList.Count - 1 do
366 ZipFileEntries.AddFileEntry(FileList[I], CreateRelativePath(FileList[I], PathEntry));
367 finally
368 FileList.Free;
369 end;
370
371 if (ZipFileEntries.Count > 0) then
372 begin
373 try
374 FZipper.ZipFiles(ZipFileEntries);
375 except
376 on E: EZipError do
377 begin
378 CanGo := False;
379 FErrMsg := E.Message;
380 Synchronize(@DoOnZipError);
381 end;
382 end;
383 end;
384 end;
385 finally
386 ZipFileEntries.Free;
387 end;
388 if CanGo then
389 Synchronize(@DoOnZipCompleted);
390 end;
391
392 constructor TPackageZipper.Create;
393 begin
394 inherited Create(True);
395 FreeOnTerminate := True;
396 FZipper := TZipper.Create;
397 end;
398
399 destructor TPackageZipper.Destroy;
400 begin
401 FZipper.Free;
402 inherited Destroy;
403 end;
404
405 procedure TPackageZipper.StartZip(const ASrcDir, AZipFile: String);
406 begin
407 if FStarted then
408 Exit;
409 FSrcDir := ASrcDir;
410 FZipFile := AZipFile;
411 FStarted := True;
412 Start;
413 end;
414
415 procedure TPackageZipper.StopZip;
416 begin
417 if Assigned(FZipper) then
418 FZipper.Terminate;
419 FNeedToBreak := True;
420 FStarted := False;
421 end;
422
423 end.
424
425