Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit ZMWorkFile19; |
2 | |||
3 | (* |
||
4 | ZMWorkFile19.pas - basic in/out for zip files |
||
5 | Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht, |
||
6 | Eric W. Engler and Chris Vleghert. |
||
7 | |||
8 | This file is part of TZipMaster Version 1.9. |
||
9 | |||
10 | TZipMaster is free software: you can redistribute it and/or modify |
||
11 | it under the terms of the GNU Lesser General Public License as published by |
||
12 | the Free Software Foundation, either version 3 of the License, or |
||
13 | (at your option) any later version. |
||
14 | |||
15 | TZipMaster is distributed in the hope that it will be useful, |
||
16 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
||
17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||
18 | GNU Lesser General Public License for more details. |
||
19 | |||
20 | You should have received a copy of the GNU Lesser General Public License |
||
21 | along with TZipMaster. If not, see <http://www.gnu.org/licenses/>. |
||
22 | |||
23 | contact: problems@delphizip.org (include ZipMaster in the subject). |
||
24 | updates: http://www.delphizip.org |
||
25 | DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip |
||
26 | |||
27 | modified 2010-06-20 |
||
28 | --------------------------------------------------------------------------- *) |
||
29 | (* |
||
30 | if Len < 0 then must process on this segment |
||
31 | ????Full - gives error if not processed non-split |
||
32 | ????Check - gives error if not all done |
||
33 | // Len = int64 |
||
34 | function Seek(offset: Int64; From: integer): Int64; virtual; |
||
35 | procedure CopyTo(var dest: TZMWorkFile; Len: Int64; ErrId: Integer); virtual; |
||
36 | // only operate on < 2G at a time |
||
37 | procedure CopyToFull(var dest: TZMWorkFile; Len, ErrId: Integer); virtual; |
||
38 | function Read(var Buffer; ReadLen: Integer): Integer; virtual; |
||
39 | procedure ReadCheck(var Buffer; Len, ErrId: Integer); virtual; |
||
40 | procedure ReadFull(var Buffer; ReadLen, DSErrIdent: Integer); virtual; |
||
41 | function Write(const Buffer; Len: Integer): Integer; virtual; |
||
42 | function WriteCheck(const Buffer; Len, ErrId: Integer): Integer; virtual; |
||
43 | procedure WriteFull(const Buffer; Len, ErrIdent: Integer); virtual; |
||
44 | *) |
||
45 | interface |
||
46 | |||
47 | uses |
||
48 | Classes, Windows, SysUtils, ZipMstr19, ZMDelZip19, ZMCore19, ZMDrv19; |
||
49 | |||
50 | // file signitures read by OpenEOC |
||
51 | type |
||
52 | TZipFileSigs = (zfsNone, zfsLocal, zfsMulti, zfsDOS); |
||
53 | |||
54 | type |
||
55 | TZipNumberScheme = (znsNone, znsVolume, znsName, znsExt); |
||
56 | |||
57 | type |
||
58 | TZipWrites = (zwDefault, zwSingle, zwMultiple); |
||
59 | |||
60 | const |
||
61 | ProgressActions: array [TZipShowProgress] of TActionCodes = |
||
62 | (zacTick, zacProgress, zacXProgress); |
||
63 | MustFitError = -10999; |
||
64 | MustFitFlag = $20000; // much bigger than any 'fixed' field |
||
65 | MustFitMask = $1FFFF; // removes flag limits 'fixed' length |
||
66 | |||
67 | type |
||
68 | // TBytArray = array of Byte; |
||
69 | TByteBuffer = array of Byte; |
||
70 | |||
71 | type |
||
72 | TZMWorkFile = class(TObject) |
||
73 | private |
||
74 | fAllowedSize: Int64; |
||
75 | FBoss: TZMCore; |
||
76 | fBytesRead: Int64; |
||
77 | fBytesWritten: Int64; |
||
78 | fDiskNr: Integer; |
||
79 | fFileName: String; |
||
80 | fFile_Size: Int64; |
||
81 | fHandle: Integer; |
||
82 | fInfo: Cardinal; |
||
83 | // fIsMultiDisk: Boolean; |
||
84 | fIsOpen: Boolean; |
||
85 | fIsTemp: Boolean; |
||
86 | fLastWrite: TFileTime; |
||
87 | fOpenMode: Cardinal; |
||
88 | fRealFileName: String; |
||
89 | fRealFileSize: Int64; |
||
90 | FReqFileName: String; |
||
91 | fShowProgress: TZipShowProgress; |
||
92 | fSig: TZipFileSigs; |
||
93 | fStampDate: Cardinal; |
||
94 | fTotalDisks: Integer; |
||
95 | fWorkDrive: TZMWorkDrive; |
||
96 | fWorker: TZMCore; |
||
97 | FZipDiskAction: TZMDiskAction; |
||
98 | FZipDiskStatus: TZMZipDiskStatus; |
||
99 | WBuf: array of Byte; |
||
100 | function GetConfirmErase: Boolean; |
||
101 | function GetExists: Boolean; |
||
102 | function GetKeepFreeOnAllDisks: Cardinal; |
||
103 | function GetKeepFreeOnDisk1: Cardinal; |
||
104 | function GetLastWritten: Cardinal; |
||
105 | function GetMaxVolumeSize: Int64; |
||
106 | function GetMinFreeVolumeSize: Cardinal; |
||
107 | function GetPosition_F: Int64; |
||
108 | function GetSpanOptions: TZMSpanOpts; |
||
109 | procedure SetBoss(const Value: TZMCore); |
||
110 | procedure SetFileName(const Value: String); |
||
111 | procedure SetHandle(const Value: Integer); |
||
112 | procedure SetKeepFreeOnAllDisks(const Value: Cardinal); |
||
113 | procedure SetKeepFreeOnDisk1(const Value: Cardinal); |
||
114 | procedure SetMaxVolumeSize(const Value: Int64); |
||
115 | procedure SetMinFreeVolumeSize(const Value: Cardinal); |
||
116 | procedure SetPosition(const Value: Int64); |
||
117 | procedure SetSpanOptions(const Value: TZMSpanOpts); |
||
118 | procedure SetWorkDrive(const Value: TZMWorkDrive); |
||
119 | protected |
||
120 | fBufferPosition: Integer; |
||
121 | fConfirmErase: Boolean; |
||
122 | fDiskBuffer: TByteBuffer; |
||
123 | FDiskWritten: Cardinal; |
||
124 | fSavedFileInfo: _BY_HANDLE_FILE_INFORMATION; |
||
125 | fIsMultiPart: Boolean; |
||
126 | FNewDisk: Boolean; |
||
127 | FNumbering: TZipNumberScheme; |
||
128 | function ChangeNumberedName(const FName: String; NewNbr: Cardinal; Remove: |
||
129 | boolean): string; |
||
130 | procedure CheckForDisk(writing, UnformOk: Boolean); |
||
131 | procedure ClearFloppy(const dir: String); |
||
132 | function Copy_File(Source: TZMWorkFile): Integer; |
||
133 | procedure Diag(const msg: String); |
||
134 | function EOS: Boolean; |
||
135 | procedure FlushDiskBuffer; |
||
136 | function GetFileInformation(var FileInfo: _BY_HANDLE_FILE_INFORMATION): Boolean; |
||
137 | function GetPosition: Int64; |
||
138 | function HasSpanSig(const FName: String): boolean; |
||
139 | function IsRightDisk: Boolean; |
||
140 | procedure NewFlushDisk; |
||
141 | function NewSegment: Boolean; |
||
142 | function VolName(Part: Integer): String; |
||
143 | function OldVolName(Part: Integer): String; |
||
144 | function WriteSplit(const Buffer; ToWrite: Integer): Integer; |
||
145 | function ZipFormat(const NewName: String): Integer; |
||
146 | property AllowedSize: Int64 Read fAllowedSize Write fAllowedSize; |
||
147 | property LastWrite: TFileTime read fLastWrite write fLastWrite; |
||
148 | property OpenMode: Cardinal read fOpenMode; |
||
149 | public |
||
150 | constructor Create(wrkr: TZMCore); virtual; |
||
151 | procedure AfterConstruction; override; |
||
152 | function AskAnotherDisk(const DiskFile: String): Integer; |
||
153 | function AskOverwriteSegment(const DiskFile: String; DiskSeq: Integer): Integer; |
||
154 | procedure AssignFrom(Src: TZMWorkFile); virtual; |
||
155 | procedure BeforeDestruction; override; |
||
156 | function CheckRead(var Buffer; Len: Integer): Boolean; overload; |
||
157 | procedure CheckRead(var Buffer; Len, ErrId: Integer); overload; |
||
158 | function CheckReads(var Buffer; const Lens: array of Integer): Boolean; |
||
159 | overload; |
||
160 | procedure CheckReads(var Buffer; const Lens: array of Integer; |
||
161 | ErrId: Integer); overload; |
||
162 | function CheckSeek(offset: Int64; from, ErrId: Integer): Int64; |
||
163 | function CheckWrite(const Buffer; Len: Integer): Boolean; overload; |
||
164 | procedure CheckWrite(const Buffer; Len, ErrId: Integer); overload; |
||
165 | function CheckWrites(const Buffer; const Lens: array of Integer): Boolean; |
||
166 | overload; |
||
167 | procedure CheckWrites(const Buffer; const Lens: array of Integer; |
||
168 | ErrId: Integer); overload; |
||
169 | procedure ClearFileInformation; |
||
170 | function CopyFrom(Source: TZMWorkFile; Len: Int64): Int64; |
||
171 | function CreateMVFileNameEx(const FileName: String; |
||
172 | StripPartNbr, Compat: Boolean): String; |
||
173 | function DoFileWrite(const Buffer; Len: Integer): Integer; |
||
174 | function FileDate: Cardinal; |
||
175 | procedure File_Close; |
||
176 | procedure File_Close_F; |
||
177 | function File_Create(const theName: String): Boolean; |
||
178 | function File_CreateTemp(const Prefix, Where: String): Boolean; |
||
179 | function File_Open(Mode: Cardinal): Boolean; |
||
180 | function File_Rename(const NewName: string; const Safe: Boolean = false) |
||
181 | : Boolean; |
||
182 | function FinishWrite: Integer; |
||
183 | procedure GetNewDisk(DiskSeq: Integer; AllowEmpty: Boolean); |
||
184 | function LastWriteTime(var last_write: TFileTime): Boolean; |
||
185 | function MapNumbering(Opts: TZMSpanOpts): TZMSpanOpts; |
||
186 | procedure ProgReport(prog: TActionCodes; xprog: Integer; const Name: String; |
||
187 | size: Int64); |
||
188 | function Read(var Buffer; Len: Integer): Integer; |
||
189 | function ReadFromFile(var Buffer; Len: Integer): Integer; |
||
190 | function Reads(var Buffer; const Lens: array of Integer): Integer; |
||
191 | function Reads_F(var Buffer; const Lens: array of Integer): Integer; |
||
192 | function ReadTo(strm: TStream; Count: Integer): Integer; |
||
193 | function Read_F(var Buffer; Len: Integer): Integer; |
||
194 | function SaveFileInformation: Boolean; |
||
195 | function Seek(offset: Int64; from: Integer): Int64; |
||
196 | function SeekDisk(Nr: Integer): Integer; |
||
197 | function SetEndOfFile: Boolean; |
||
198 | function VerifyFileInformation: Boolean; |
||
199 | function WBuffer(size: Integer): pByte; |
||
200 | function Write(const Buffer; Len: Integer): Integer; |
||
201 | function WriteFrom(strm: TStream; Count: Integer): Int64; |
||
202 | function Writes(const Buffer; const Lens: array of Integer): Integer; |
||
203 | function Writes_F(const Buffer; const Lens: array of Integer): Integer; |
||
204 | function WriteToFile(const Buffer; Len: Integer): Integer; |
||
205 | function Write_F(const Buffer; Len: Integer): Integer; |
||
206 | property Boss: TZMCore read FBoss write SetBoss; |
||
207 | property BytesRead: Int64 read fBytesRead write fBytesRead; |
||
208 | property BytesWritten: Int64 read fBytesWritten write fBytesWritten; |
||
209 | property ConfirmErase: Boolean read GetConfirmErase write fConfirmErase; |
||
210 | property DiskNr: Integer read fDiskNr write fDiskNr; |
||
211 | property Exists: Boolean read GetExists; |
||
212 | property FileName: String read fFileName write SetFileName; |
||
213 | property File_Size: Int64 read fFile_Size write fFile_Size; |
||
214 | property Handle: Integer read fHandle write SetHandle; |
||
215 | property info: Cardinal read fInfo write fInfo; |
||
216 | property IsMultiPart: Boolean read fIsMultiPart write fIsMultiPart; |
||
217 | property IsOpen: Boolean read fIsOpen; |
||
218 | property IsTemp: Boolean read fIsTemp write fIsTemp; |
||
219 | property KeepFreeOnAllDisks: Cardinal read GetKeepFreeOnAllDisks write |
||
220 | SetKeepFreeOnAllDisks; |
||
221 | property KeepFreeOnDisk1: Cardinal read GetKeepFreeOnDisk1 write |
||
222 | SetKeepFreeOnDisk1; |
||
223 | property LastWritten: Cardinal read GetLastWritten; |
||
224 | property MaxVolumeSize: Int64 read GetMaxVolumeSize write SetMaxVolumeSize; |
||
225 | property MinFreeVolumeSize: Cardinal read GetMinFreeVolumeSize write |
||
226 | SetMinFreeVolumeSize; |
||
227 | property NewDisk: Boolean Read FNewDisk Write FNewDisk; |
||
228 | property Numbering: TZipNumberScheme Read FNumbering Write FNumbering; |
||
229 | property Position: Int64 read GetPosition write SetPosition; |
||
230 | property RealFileName: String read fRealFileName; |
||
231 | property RealFileSize: Int64 read fRealFileSize write fRealFileSize; |
||
232 | property ReqFileName: String Read FReqFileName Write FReqFileName; |
||
233 | property ShowProgress |
||
234 | : TZipShowProgress read fShowProgress write fShowProgress; |
||
235 | property Sig: TZipFileSigs read fSig write fSig; |
||
236 | property SpanOptions: TZMSpanOpts read GetSpanOptions write SetSpanOptions; |
||
237 | // if non-zero set fileDate |
||
238 | property StampDate: Cardinal read fStampDate write fStampDate; |
||
239 | property TotalDisks: Integer read fTotalDisks write fTotalDisks; |
||
240 | property WorkDrive: TZMWorkDrive read fWorkDrive write SetWorkDrive; |
||
241 | property Worker: TZMCore read fWorker write fWorker; |
||
242 | end; |
||
243 | |||
244 | const |
||
245 | // zfi_None: Cardinal = 0; |
||
246 | // zfi_Open: Cardinal = 1; |
||
247 | // zfi_Create: Cardinal = 2; |
||
248 | zfi_Dirty: Cardinal = 4; |
||
249 | zfi_MakeMask: Cardinal = $07; |
||
250 | zfi_Error: Cardinal = 8; |
||
251 | // zfi_NotFound: cardinal = $10; // named file not found |
||
252 | // zfi_NoLast: cardinal = $20; // last file not found |
||
253 | zfi_Loading: cardinal = $40; |
||
254 | zfi_Cancelled: cardinal = $80; // loading was cancelled |
||
255 | // zfi_FileMask: cardinal = $F0; |
||
256 | |||
257 | function FileTimeToLocalDOSTime(const ft: TFileTime): Cardinal; |
||
258 | |||
259 | implementation |
||
260 | |||
261 | uses |
||
262 | Forms, Controls, Dialogs, ZMMsgStr19, ZMCtx19, ZMCompat19, ZMDlg19, |
||
263 | ZMStructs19, ZMUtils19, ZMMsg19, ZMXcpt19; |
||
264 | {$I '.\ZipVers19.inc'} |
||
265 | {$IFDEF VER180} |
||
266 | {$WARN SYMBOL_DEPRECATED OFF} |
||
267 | {$ENDIF} |
||
268 | |||
269 | const |
||
270 | MAX_PARTS = 999; |
||
271 | MaxDiskBufferSize = (4 * 1024 * 1024); // floppies only |
||
272 | |||
273 | const |
||
274 | SZipSet = 'ZipSet_'; |
||
275 | SPKBACK = 'PKBACK#'; |
||
276 | |||
277 | (* ? FormatFloppy |
||
278 | *) |
||
279 | function FormatFloppy(WND: HWND; const Drive: String): Integer; |
||
280 | const |
||
281 | SHFMT_ID_DEFAULT = $FFFF; |
||
282 | { options } |
||
283 | SHFMT_OPT_FULL = $0001; |
||
284 | // SHFMT_OPT_SYSONLY = $0002; |
||
285 | { return values } |
||
286 | // SHFMT_ERROR = $FFFFFFFF; |
||
287 | // -1 Error on last format, drive may be formatable |
||
288 | // SHFMT_CANCEL = $FFFFFFFE; // -2 last format cancelled |
||
289 | // SHFMT_NOFORMAT = $FFFFFFFD; // -3 drive is not formatable |
||
290 | type |
||
291 | TSHFormatDrive = function(WND: HWND; Drive, fmtID, Options: DWORD): DWORD; |
||
292 | stdcall; |
||
293 | var |
||
294 | SHFormatDrive: TSHFormatDrive; |
||
295 | var |
||
296 | drv: Integer; |
||
297 | hLib: THandle; |
||
298 | OldErrMode: Integer; |
||
299 | begin |
||
300 | Result := -3; // error |
||
301 | if not((Length(Drive) > 1) and (Drive[2] = ':') and CharInSet |
||
302 | (Drive[1], ['A' .. 'Z', 'a' .. 'z'])) then |
||
303 | exit; |
||
304 | if GetDriveType(PChar(Drive)) <> DRIVE_REMOVABLE then |
||
305 | exit; |
||
306 | drv := Ord(Upcase(Drive[1])) - Ord('A'); |
||
307 | OldErrMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOGPFAULTERRORBOX); |
||
308 | hLib := LoadLibrary('Shell32'); |
||
309 | if hLib <> 0 then |
||
310 | begin |
||
311 | @SHFormatDrive := GetProcAddress(hLib, 'SHFormatDrive'); |
||
312 | if @SHFormatDrive <> nil then |
||
313 | try |
||
314 | Result := SHFormatDrive(WND, drv, SHFMT_ID_DEFAULT, SHFMT_OPT_FULL); |
||
315 | finally |
||
316 | FreeLibrary(hLib); |
||
317 | end; |
||
318 | SetErrorMode(OldErrMode); |
||
319 | end; |
||
320 | end; |
||
321 | |||
322 | function FileTimeToLocalDOSTime(const ft: TFileTime): Cardinal; |
||
323 | var |
||
324 | lf: TFileTime; |
||
325 | wd: Word; |
||
326 | wt: Word; |
||
327 | begin |
||
328 | Result := 0; |
||
329 | if FileTimeToLocalFileTime(ft, lf) and FileTimeToDosDateTime(lf, wd, wt) then |
||
330 | Result := (wd shl 16) or wt; |
||
331 | end; |
||
332 | |||
333 | { TZMWorkFile } |
||
334 | |||
335 | constructor TZMWorkFile.Create(wrkr: TZMCore); |
||
336 | begin |
||
337 | inherited Create; |
||
338 | fWorker := wrkr; |
||
339 | fBoss := wrkr; |
||
340 | end; |
||
341 | |||
342 | procedure TZMWorkFile.AfterConstruction; |
||
343 | begin |
||
344 | inherited; |
||
345 | fDiskBuffer := nil; |
||
346 | fBufferPosition := -1; |
||
347 | fInfo := 0; |
||
348 | fHandle := -1; |
||
349 | fIsMultiPart := false; |
||
350 | fBytesWritten := 0; |
||
351 | fBytesRead := 0; |
||
352 | fOpenMode := 0; |
||
353 | fNumbering := znsNone; |
||
354 | fWorkDrive := TZMWorkDrive.Create; |
||
355 | ClearFileInformation; |
||
356 | end; |
||
357 | |||
358 | function TZMWorkFile.AskAnotherDisk(const DiskFile: String): Integer; |
||
359 | var |
||
360 | MsgQ: String; |
||
361 | tmpStatusDisk: TZMStatusDiskEvent; |
||
362 | begin |
||
363 | MsgQ := Boss.ZipLoadStr(DS_AnotherDisk); |
||
364 | FZipDiskStatus := FZipDiskStatus + [zdsSameFileName]; |
||
365 | tmpStatusDisk := worker.Master.OnStatusDisk; |
||
366 | if Assigned(tmpStatusDisk) and not(zaaYesOvrwrt in Worker.AnswerAll) then |
||
367 | begin |
||
368 | FZipDiskAction := zdaOk; // The default action |
||
369 | tmpStatusDisk(Boss.Master, 0, DiskFile, FZipDiskStatus, FZipDiskAction); |
||
370 | case FZipDiskAction of |
||
371 | zdaCancel: |
||
372 | Result := idCancel; |
||
373 | zdaReject: |
||
374 | Result := idNo; |
||
375 | zdaErase: |
||
376 | Result := idOk; |
||
377 | zdaYesToAll: |
||
378 | begin |
||
379 | Result := idOk; |
||
380 | // Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt]; |
||
381 | end; |
||
382 | zdaOk: |
||
383 | Result := idOk; |
||
384 | else |
||
385 | Result := idOk; |
||
386 | end; |
||
387 | end |
||
388 | else |
||
389 | Result := Boss.ZipMessageDlgEx(Boss.ZipLoadStr(FM_Confirm), MsgQ, |
||
390 | zmtWarning + DHC_SpanOvr, [mbOk, mbCancel]); |
||
391 | end; |
||
392 | |||
393 | function TZMWorkFile.AskOverwriteSegment(const DiskFile: String; DiskSeq: |
||
394 | Integer): Integer; |
||
395 | var |
||
396 | MsgQ: String; |
||
397 | tmpStatusDisk: TZMStatusDiskEvent; |
||
398 | begin |
||
399 | // Do we want to overwrite an existing file? |
||
400 | if FileExists(DiskFile) then |
||
401 | if (File_Age(DiskFile) = StampDate) and (Pred(DiskSeq) < DiskNr) |
||
402 | then |
||
403 | begin |
||
404 | MsgQ := Boss.ZipFmtLoadStr(DS_AskPrevFile, [DiskSeq]); |
||
405 | FZipDiskStatus := FZipDiskStatus + [zdsPreviousDisk]; |
||
406 | end |
||
407 | else |
||
408 | begin |
||
409 | MsgQ := Boss.ZipFmtLoadStr(DS_AskDeleteFile, [DiskFile]); |
||
410 | FZipDiskStatus := FZipDiskStatus + [zdsSameFileName]; |
||
411 | end |
||
412 | else if not WorkDrive.DriveIsFixed then |
||
413 | if (WorkDrive.VolumeSize <> WorkDrive.VolumeSpace) then |
||
414 | FZipDiskStatus := FZipDiskStatus + [zdsHasFiles] |
||
415 | // But not the same name |
||
416 | else |
||
417 | FZipDiskStatus := FZipDiskStatus + [zdsEmpty]; |
||
418 | tmpStatusDisk := worker.Master.OnStatusDisk; |
||
419 | if Assigned(tmpStatusDisk) and not(zaaYesOvrwrt in Worker.AnswerAll) then |
||
420 | begin |
||
421 | FZipDiskAction := zdaOk; // The default action |
||
422 | tmpStatusDisk(Boss.Master, DiskSeq, DiskFile, FZipDiskStatus, |
||
423 | FZipDiskAction); |
||
424 | case FZipDiskAction of |
||
425 | zdaCancel: |
||
426 | Result := idCancel; |
||
427 | zdaReject: |
||
428 | Result := idNo; |
||
429 | zdaErase: |
||
430 | Result := idOk; |
||
431 | zdaYesToAll: |
||
432 | begin |
||
433 | Result := idOk; |
||
434 | Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt]; |
||
435 | end; |
||
436 | zdaOk: |
||
437 | Result := idOk; |
||
438 | else |
||
439 | Result := idOk; |
||
440 | end; |
||
441 | end |
||
442 | else if ((FZipDiskStatus * [zdsPreviousDisk, zdsSameFileName]) <> []) and not |
||
443 | ((zaaYesOvrwrt in Worker.AnswerAll) or Worker.Unattended) then |
||
444 | begin |
||
445 | Result := Boss.ZipMessageDlgEx(Boss.ZipLoadStr(FM_Confirm), MsgQ, |
||
446 | zmtWarning + DHC_SpanOvr, [mbYes, mbNo, mbCancel, mbYesToAll]); |
||
447 | if Result = mrYesToAll then |
||
448 | begin |
||
449 | Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt]; |
||
450 | Result := idOk; |
||
451 | end; |
||
452 | end |
||
453 | else |
||
454 | Result := idOk; |
||
455 | end; |
||
456 | |||
457 | // Src should not be open but not enforced |
||
458 | procedure TZMWorkFile.AssignFrom(Src: TZMWorkFile); |
||
459 | begin |
||
460 | if (Src <> Self) and (Src <> nil) then |
||
461 | begin |
||
462 | fDiskBuffer := nil; |
||
463 | fBufferPosition := -1; |
||
464 | Move(Src.fSavedFileInfo, fSavedFileInfo, SizeOf(fSavedFileInfo)); |
||
465 | fAllowedSize := Src.fAllowedSize; |
||
466 | fBytesRead := Src.fBytesRead; |
||
467 | fBytesWritten := Src.fBytesWritten; |
||
468 | fDiskNr := Src.fDiskNr; |
||
469 | fFile_Size := Src.fFile_Size; |
||
470 | fFileName := Src.fFileName; |
||
471 | fHandle := -1; // don't acquire handle |
||
472 | fInfo := Src.fInfo; |
||
473 | // fIsMultiDisk := Src.fIsMultiDisk; |
||
474 | fIsOpen := False; |
||
475 | fIsTemp := Src.fIsTemp; |
||
476 | fLastWrite := Src.fLastWrite; |
||
477 | fNumbering := Src.fNumbering; |
||
478 | fOpenMode := Src.fOpenMode; |
||
479 | fRealFileName := Src.fRealFileName; |
||
480 | fReqFileName := Src.FReqFileName; |
||
481 | fShowProgress := Src.fShowProgress; |
||
482 | fSig := Src.fSig; |
||
483 | fStampDate := Src.fStampDate; |
||
484 | fTotalDisks := Src.fTotalDisks; |
||
485 | fWorkDrive.AssignFrom(Src.WorkDrive); |
||
486 | FZipDiskAction := Src.FZipDiskAction; |
||
487 | FZipDiskStatus := Src.FZipDiskStatus; |
||
488 | end; |
||
489 | end; |
||
490 | |||
491 | procedure TZMWorkFile.BeforeDestruction; |
||
492 | begin |
||
493 | File_Close; |
||
494 | if IsTemp and FileExists(fRealFileName) then |
||
495 | begin |
||
496 | if Boss.Verbosity >= zvTrace then |
||
497 | Diag('Trace: Deleting ' + fRealFileName); |
||
498 | SysUtils.DeleteFile(fFileName); |
||
499 | end; |
||
500 | FreeAndNil(fWorkDrive); |
||
501 | fDiskBuffer := nil; // ++ discard contents |
||
502 | WBuf := nil; |
||
503 | inherited; |
||
504 | end; |
||
505 | |||
506 | // uses 'real' number |
||
507 | function TZMWorkFile.ChangeNumberedName(const FName: String; NewNbr: Cardinal; |
||
508 | Remove: boolean): string; |
||
509 | var |
||
510 | ext: string; |
||
511 | StripLen: Integer; |
||
512 | begin |
||
513 | if DiskNr > 999 then |
||
514 | raise EZipMaster.CreateResDisp(DS_TooManyParts, True); |
||
515 | ext := ExtractFileExt(FName); |
||
516 | StripLen := 0; |
||
517 | if Remove then |
||
518 | StripLen := 3; |
||
519 | Result := Copy(FName, 1, Length(FName) - Length(ext) - StripLen) |
||
520 | + Copy(IntToStr(1000 + NewNbr), 2, 3) + ext; |
||
521 | end; |
||
522 | |||
523 | procedure TZMWorkFile.CheckForDisk(writing, UnformOk: Boolean); |
||
524 | var |
||
525 | OnGetNextDisktmp: TZMGetNextDiskEvent; |
||
526 | AbortAction: Boolean; |
||
527 | MsgFlag: Integer; |
||
528 | MsgStr: String; |
||
529 | Res: Integer; |
||
530 | SizeOfDisk: Int64; |
||
531 | totDisks: Integer; |
||
532 | begin |
||
533 | if TotalDisks <> 1 then // check |
||
534 | IsMultiPart := True; |
||
535 | if WorkDrive.DriveIsFixed then |
||
536 | begin |
||
537 | // If it is a fixed disk we don't want a new one. |
||
538 | NewDisk := false; |
||
539 | Boss.CheckCancel; |
||
540 | exit; |
||
541 | end; |
||
542 | Boss.KeepAlive; // just ProcessMessages |
||
543 | // First check if we want a new one or if there is a disk (still) present. |
||
544 | while (NewDisk or (not WorkDrive.HasMedia(UnformOk))) do |
||
545 | begin |
||
546 | if Boss.Unattended then |
||
547 | raise EZipMaster.CreateResDisp(DS_NoUnattSpan, True); |
||
548 | |||
549 | MsgFlag := zmtWarning + DHC_SpanNxtW; // or error? |
||
550 | if DiskNr < 0 then // want last disk |
||
551 | begin |
||
552 | MsgStr := Boss.ZipLoadStr(DS_InsertDisk); |
||
553 | MsgFlag := zmtError + DHC_SpanNxtR; |
||
554 | end |
||
555 | else if writing then |
||
556 | begin |
||
557 | // This is an estimate, we can't know if every future disk has the same space available and |
||
558 | // if there is no disk present we can't determine the size unless it's set by MaxVolumeSize. |
||
559 | SizeOfDisk := WorkDrive.VolumeSize - KeepFreeOnAllDisks; |
||
560 | if (MaxVolumeSize <> 0) and (MaxVolumeSize < WorkDrive.VolumeSize) then |
||
561 | SizeOfDisk := MaxVolumeSize; |
||
562 | |||
563 | TotalDisks := DiskNr + 1; |
||
564 | if TotalDisks > MAX_PARTS then |
||
565 | raise EZipMaster.CreateResDisp(DS_TooManyParts, True); |
||
566 | if SizeOfDisk > 0 then |
||
567 | begin |
||
568 | totDisks := Trunc((File_Size + 4 + KeepFreeOnDisk1) / SizeOfDisk); |
||
569 | if TotalDisks < totDisks then |
||
570 | TotalDisks := totDisks; |
||
571 | MsgStr := Boss.ZipFmtLoadStr |
||
572 | (DS_InsertVolume, [DiskNr + 1, TotalDisks]); |
||
573 | end |
||
574 | else |
||
575 | MsgStr := Boss.ZipFmtLoadStr(DS_InsertAVolume, [DiskNr + 1]); |
||
576 | end |
||
577 | else |
||
578 | begin // reading - want specific disk |
||
579 | if TotalDisks = 0 then |
||
580 | MsgStr := Boss.ZipFmtLoadStr(DS_InsertAVolume, [DiskNr + 1]) |
||
581 | else |
||
582 | MsgStr := Boss.ZipFmtLoadStr(DS_InsertVolume, [DiskNr + 1, TotalDisks]); |
||
583 | end; |
||
584 | |||
585 | MsgStr := MsgStr + Boss.ZipFmtLoadStr(DS_InDrive, [WorkDrive.DriveStr]); |
||
586 | OnGetNextDisktmp := Worker.Master.OnGetNextDisk; |
||
587 | if Assigned(OnGetNextDisktmp) then |
||
588 | begin |
||
589 | AbortAction := false; |
||
590 | OnGetNextDisktmp(Boss.Master, DiskNr + 1, TotalDisks, Copy |
||
591 | (WorkDrive.DriveStr, 1, 1), AbortAction); |
||
592 | if AbortAction then |
||
593 | Res := idAbort |
||
594 | else |
||
595 | Res := idOk; |
||
596 | end |
||
597 | else |
||
598 | Res := Boss.ZipMessageDlgEx('', MsgStr, MsgFlag, mbOkCancel); |
||
599 | |||
600 | // Check if user pressed Cancel or memory is running out. |
||
601 | if Res = 0 then |
||
602 | raise EZipMaster.CreateResDisp(DS_NoMem, True); |
||
603 | if Res <> idOk then |
||
604 | begin |
||
605 | Boss.Cancel := GE_Abort; |
||
606 | info := info or zfi_Cancelled; |
||
607 | raise EZipMaster.CreateResDisp(DS_Canceled, false); |
||
608 | end; |
||
609 | NewDisk := false; |
||
610 | Boss.KeepAlive; |
||
611 | end; |
||
612 | end; |
||
613 | |||
614 | function TZMWorkFile.CheckRead(var Buffer; Len: Integer): Boolean; |
||
615 | begin |
||
616 | if Len < 0 then |
||
617 | Len := -Len; |
||
618 | Result := Read(Buffer, Len) = Len; |
||
619 | end; |
||
620 | |||
621 | procedure TZMWorkFile.CheckRead(var Buffer; Len, ErrId: Integer); |
||
622 | begin |
||
623 | if Len < 0 then |
||
624 | Len := -Len; |
||
625 | if not CheckRead(Buffer, Len) then |
||
626 | begin |
||
627 | if ErrId = 0 then |
||
628 | ErrId := DS_ReadError; |
||
629 | raise EZipMaster.CreateResDisp(ErrId, True); |
||
630 | end; |
||
631 | end; |
||
632 | |||
633 | function TZMWorkFile.CheckReads(var Buffer; const Lens: array of Integer) |
||
634 | : Boolean; |
||
635 | var |
||
636 | c: Integer; |
||
637 | i: Integer; |
||
638 | begin |
||
639 | c := 0; |
||
640 | for i := Low(Lens) to High(Lens) do |
||
641 | c := c + Lens[i]; |
||
642 | Result := Reads(Buffer, Lens) = c; |
||
643 | end; |
||
644 | |||
645 | procedure TZMWorkFile.CheckReads(var Buffer; const Lens: array of Integer; |
||
646 | ErrId: Integer); |
||
647 | begin |
||
648 | if not CheckReads(Buffer, Lens) then |
||
649 | begin |
||
650 | if ErrId = 0 then |
||
651 | ErrId := DS_ReadError; |
||
652 | raise EZipMaster.CreateResDisp(ErrId, True); |
||
653 | end; |
||
654 | end; |
||
655 | |||
656 | function TZMWorkFile.CheckSeek(offset: Int64; from, ErrId: Integer): Int64; |
||
657 | begin |
||
658 | Result := Seek(offset, from); |
||
659 | if Result < 0 then |
||
660 | begin |
||
661 | if ErrId = 0 then |
||
662 | raise EZipMaster.CreateResDisp(DS_SeekError, True); |
||
663 | if ErrId = -1 then |
||
664 | ErrId := DS_FailedSeek; |
||
665 | raise EZipMaster.CreateResDisp(ErrId, True); |
||
666 | end; |
||
667 | end; |
||
668 | |||
669 | function TZMWorkFile.CheckWrite(const Buffer; Len: Integer): Boolean; |
||
670 | begin |
||
671 | if Len < 0 then |
||
672 | Len := -Len; |
||
673 | Result := Write(Buffer, Len) = Len; |
||
674 | end; |
||
675 | |||
676 | procedure TZMWorkFile.CheckWrite(const Buffer; Len, ErrId: Integer); |
||
677 | begin |
||
678 | if not CheckWrite(Buffer, Len) then |
||
679 | begin |
||
680 | if ErrId = 0 then |
||
681 | ErrId := DS_WriteError; |
||
682 | raise EZipMaster.CreateResDisp(ErrId, True); |
||
683 | end; |
||
684 | end; |
||
685 | |||
686 | function TZMWorkFile.CheckWrites(const Buffer; const Lens: array of Integer) |
||
687 | : Boolean; |
||
688 | var |
||
689 | c: Integer; |
||
690 | i: Integer; |
||
691 | begin |
||
692 | c := 0; |
||
693 | for i := Low(Lens) to High(Lens) do |
||
694 | c := c + Lens[i]; |
||
695 | Result := Writes(Buffer, Lens) = c; |
||
696 | end; |
||
697 | |||
698 | // must read from current part |
||
699 | procedure TZMWorkFile.CheckWrites(const Buffer; const Lens: array of Integer; |
||
700 | ErrId: Integer); |
||
701 | begin |
||
702 | if not CheckWrites(Buffer, Lens) then |
||
703 | begin |
||
704 | if ErrId = 0 then |
||
705 | ErrId := DS_WriteError; |
||
706 | raise EZipMaster.CreateResDisp(ErrId, True); |
||
707 | end; |
||
708 | end; |
||
709 | |||
710 | procedure TZMWorkFile.ClearFileInformation; |
||
711 | begin |
||
712 | ZeroMemory(@fSavedFileInfo, sizeof(_BY_HANDLE_FILE_INFORMATION)); |
||
713 | end; |
||
714 | |||
715 | procedure TZMWorkFile.ClearFloppy(const dir: String); |
||
716 | var |
||
717 | Fname: String; |
||
718 | SRec: TSearchRec; |
||
719 | begin |
||
720 | if FindFirst(dir + WILD_ALL, faAnyFile, SRec) = 0 then |
||
721 | repeat |
||
722 | Fname := dir + SRec.Name; |
||
723 | if ((SRec.Attr and faDirectory) <> 0) and (SRec.Name <> DIR_THIS) and |
||
724 | (SRec.Name <> DIR_PARENT) then |
||
725 | begin |
||
726 | Fname := Fname + PathDelim; |
||
727 | ClearFloppy(Fname); |
||
728 | if Boss.Verbosity >= zvTrace then |
||
729 | Boss.ReportMsg(TM_Erasing, [Fname]) |
||
730 | else |
||
731 | Boss.KeepAlive; |
||
732 | // allow time for OS to delete last file |
||
733 | RemoveDir(Fname); |
||
734 | end |
||
735 | else |
||
736 | begin |
||
737 | if Boss.Verbosity >= zvTrace then |
||
738 | Boss.ReportMsg(TM_Deleting, [Fname]) |
||
739 | else |
||
740 | Boss.KeepAlive; |
||
741 | SysUtils.DeleteFile(Fname); |
||
742 | end; |
||
743 | until FindNext(SRec) <> 0; |
||
744 | SysUtils.FindClose(SRec); |
||
745 | end; |
||
746 | |||
747 | function TZMWorkFile.CopyFrom(Source: TZMWorkFile; Len: Int64): Int64; |
||
748 | var |
||
749 | BufSize: Cardinal; |
||
750 | SizeR: Integer; |
||
751 | ToRead: Integer; |
||
752 | wb: pByte; |
||
753 | begin |
||
754 | BufSize := 10 * 1024; // constant is somewhere |
||
755 | wb := WBuffer(BufSize); |
||
756 | Result := 0; |
||
757 | |||
758 | while Len > 0 do |
||
759 | begin |
||
760 | ToRead := BufSize; |
||
761 | if Len < BufSize then |
||
762 | ToRead := Len; |
||
763 | SizeR := Source.Read(wb^, ToRead); |
||
764 | if SizeR <> ToRead then |
||
765 | begin |
||
766 | if SizeR < 0 then |
||
767 | Result := SizeR |
||
768 | else |
||
769 | Result := -DS_ReadError; |
||
770 | exit; |
||
771 | end; |
||
772 | if SizeR > 0 then |
||
773 | begin |
||
774 | ToRead := Write(wb^, SizeR); |
||
775 | if SizeR <> ToRead then |
||
776 | begin |
||
777 | if ToRead < 0 then |
||
778 | Result := ToRead |
||
779 | else |
||
780 | Result := -DS_WriteError; |
||
781 | exit; |
||
782 | end; |
||
783 | Len := Len - SizeR; |
||
784 | Result := Result + SizeR; |
||
785 | ProgReport(zacProgress, PR_Copying, Source.FileName, SizeR); |
||
786 | end; |
||
787 | end; |
||
788 | end; |
||
789 | |||
790 | function TZMWorkFile.Copy_File(Source: TZMWorkFile): Integer; |
||
791 | var |
||
792 | fsize: Int64; |
||
793 | r: Int64; |
||
794 | begin |
||
795 | try |
||
796 | if not Source.IsOpen then |
||
797 | Source.File_Open(fmOpenRead); |
||
798 | Result := 0; |
||
799 | fsize := Source.Seek(0, 2); |
||
800 | Source.Seek(0, 0); |
||
801 | ProgReport(zacXItem, PR_Copying, Source.FileName, fsize); |
||
802 | r := self.CopyFrom(Source, fsize); |
||
803 | if r < 0 then |
||
804 | Result := Integer(r); |
||
805 | except |
||
806 | Result := -9; // general error |
||
807 | end; |
||
808 | end; |
||
809 | |||
810 | function TZMWorkFile.CreateMVFileNameEx(const FileName: String; |
||
811 | StripPartNbr, Compat: Boolean): String; |
||
812 | var |
||
813 | ext: String; |
||
814 | begin // changes FileName into multi volume FileName |
||
815 | if Compat then |
||
816 | begin |
||
817 | if DiskNr <> (TotalDisks - 1) then |
||
818 | begin |
||
819 | if DiskNr < 9 then |
||
820 | ext := '.z0' |
||
821 | else |
||
822 | ext := '.z'; |
||
823 | ext := ext + IntToStr(succ(DiskNr)); |
||
824 | end |
||
825 | else |
||
826 | ext := EXT_ZIP; |
||
827 | Result := ChangeFileExt(FileName, ext); |
||
828 | end |
||
829 | else |
||
830 | Result := ChangeNumberedName(FileName, DiskNr + 1, StripPartNbr); |
||
831 | end; |
||
832 | |||
833 | procedure TZMWorkFile.Diag(const msg: String); |
||
834 | begin |
||
835 | if Boss.Verbosity >= zvTrace then |
||
836 | Boss.ReportMessage(0, msg); |
||
837 | end; |
||
838 | |||
839 | function TZMWorkFile.DoFileWrite(const Buffer; Len: Integer): Integer; |
||
840 | begin |
||
841 | Result := FileWrite(fHandle, Buffer, Len); |
||
842 | end; |
||
843 | |||
844 | // return true if end of segment |
||
845 | // WARNING - repositions to end of segment |
||
846 | function TZMWorkFile.EOS: Boolean; |
||
847 | begin |
||
848 | Result := FileSeek64(Handle, 0, soFromCurrent) = FileSeek64 |
||
849 | (Handle, 0, soFromEnd); |
||
850 | end; |
||
851 | |||
852 | function TZMWorkFile.FileDate: Cardinal; |
||
853 | begin |
||
854 | Result := FileGetDate(fHandle); |
||
855 | end; |
||
856 | |||
857 | procedure TZMWorkFile.File_Close; |
||
858 | begin |
||
859 | if fDiskBuffer <> nil then |
||
860 | FlushDiskBuffer; |
||
861 | File_Close_F; |
||
862 | // inherited; |
||
863 | end; |
||
864 | |||
865 | procedure TZMWorkFile.File_Close_F; |
||
866 | var |
||
867 | th: Integer; |
||
868 | begin |
||
869 | if fHandle <> -1 then |
||
870 | begin |
||
871 | th := fHandle; |
||
872 | fHandle := -1; |
||
873 | // if open for writing set date |
||
874 | if (StampDate <> 0) and |
||
875 | ((OpenMode and (SysUtils.fmOpenReadWrite or SysUtils.fmOpenWrite)) <> 0) then |
||
876 | begin |
||
877 | FileSetDate(th, StampDate); |
||
878 | if Boss.Verbosity >= zvTrace then |
||
879 | Diag('Trace: Set file Date ' + fRealFileName + ' to ' + DateTimeToStr |
||
880 | (FileDateToLocalDateTime(StampDate))); |
||
881 | end; |
||
882 | FileClose(th); |
||
883 | if Boss.Verbosity >= zvTrace then |
||
884 | Diag('Trace: Closed ' + fRealFileName); |
||
885 | end; |
||
886 | fIsOpen := false; |
||
887 | end; |
||
888 | |||
889 | function TZMWorkFile.File_Create(const theName: String): Boolean; |
||
890 | var |
||
891 | n: String; |
||
892 | begin |
||
893 | File_Close; |
||
894 | Result := false; |
||
895 | if theName <> '' then |
||
896 | begin |
||
897 | if FileName = '' then |
||
898 | FileName := theName; |
||
899 | n := theName; |
||
900 | end |
||
901 | else |
||
902 | n := FileName; |
||
903 | if n = '' then |
||
904 | exit; |
||
905 | if Boss.Verbosity >= zvTrace then |
||
906 | Diag('Trace: Creating ' + n); |
||
907 | fRealFileName := n; |
||
908 | fHandle := FileCreate(n); |
||
909 | if fHandle <> -1 then |
||
910 | TZMCore(Worker).AddCleanupFile(n); |
||
911 | fBytesWritten := 0; |
||
912 | fBytesRead := 0; |
||
913 | Result := fHandle <> -1; |
||
914 | fIsOpen := Result; |
||
915 | fOpenMode := SysUtils.fmOpenWrite; |
||
916 | end; |
||
917 | |||
918 | function TZMWorkFile.File_CreateTemp(const Prefix, Where: String): Boolean; |
||
919 | var |
||
920 | Buf: String; |
||
921 | Len: DWORD; |
||
922 | tmpDir: String; |
||
923 | begin |
||
924 | Result := false; |
||
925 | if Length(Boss.TempDir) = 0 then |
||
926 | begin |
||
927 | if Length(Where) <> 0 then |
||
928 | begin |
||
929 | tmpDir := ExtractFilePath(Where); |
||
930 | tmpDir := ExpandFileName(tmpDir); |
||
931 | end; |
||
932 | // if Length(Worker.TempDir) = 0 then // Get the system temp dir |
||
933 | if Length(tmpDir) = 0 then // Get the system temp dir |
||
934 | begin |
||
935 | // 1. The path specified by the TMP environment variable. |
||
936 | // 2. The path specified by the TEMP environment variable, if TMP is not defined. |
||
937 | // 3. The current directory, if both TMP and TEMP are not defined. |
||
938 | Len := GetTempPath(0, PChar(tmpDir)); |
||
939 | SetLength(tmpDir, Len); |
||
940 | GetTempPath(Len, PChar(tmpDir)); |
||
941 | end; |
||
942 | end |
||
943 | else // Use Temp dir provided by ZipMaster |
||
944 | begin |
||
945 | tmpDir := Boss.TempDir; |
||
946 | end; |
||
947 | tmpDir := DelimitPath(tmpDir, True); |
||
948 | SetLength(Buf, MAX_PATH + 12); |
||
949 | if GetTempFileName(PChar(tmpDir), PChar(Prefix), 0, PChar(Buf)) <> 0 then |
||
950 | begin |
||
951 | FileName := PChar(Buf); |
||
952 | IsTemp := True; // delete when finished |
||
953 | if Boss.Verbosity >= zvTrace then |
||
954 | Diag('Trace: Created temporary ' + FileName); |
||
955 | fRealFileName := FileName; |
||
956 | fBytesWritten := 0; |
||
957 | fBytesRead := 0; |
||
958 | fOpenMode := SysUtils.fmOpenWrite; |
||
959 | Result := File_Open(fmOpenWrite); |
||
960 | end; |
||
961 | end; |
||
962 | |||
963 | function TZMWorkFile.File_Open(Mode: Cardinal): Boolean; |
||
964 | begin |
||
965 | File_Close; |
||
966 | if Boss.Verbosity >= zvTrace then |
||
967 | Diag('Trace: Opening ' + fFileName); |
||
968 | fRealFileName := fFileName; |
||
969 | fHandle := FileOpen(fFileName, Mode); |
||
970 | Result := fHandle <> -1; |
||
971 | fIsOpen := Result; |
||
972 | fOpenMode := Mode; |
||
973 | end; |
||
974 | |||
975 | function TZMWorkFile.File_Rename(const NewName: string; |
||
976 | const Safe: Boolean = false): Boolean; |
||
977 | begin |
||
978 | if Boss.Verbosity >= zvTrace then |
||
979 | Diag('Trace: Rename ' + RealFileName + ' to ' + NewName); |
||
980 | IsTemp := false; |
||
981 | if IsOpen then |
||
982 | File_Close; |
||
983 | if FileExists(FileName) then |
||
984 | begin |
||
985 | if FileExists(NewName) then |
||
986 | begin |
||
987 | if Boss.Verbosity >= zvTrace then |
||
988 | Diag('Trace: Erasing ' + NewName); |
||
989 | if (EraseFile(NewName, not Safe) <> 0) and (Boss.Verbosity >= zvTrace) |
||
990 | then |
||
991 | Diag('Trace: Erase failed ' + NewName); |
||
992 | end; |
||
993 | end; |
||
994 | Result := RenameFile(FileName, NewName); |
||
995 | if Result then |
||
996 | begin |
||
997 | fFileName := NewName; // success |
||
998 | fRealFileName := NewName; |
||
999 | end; |
||
1000 | end; |
||
1001 | |||
1002 | // rename last part after Write |
||
1003 | function TZMWorkFile.FinishWrite: Integer; |
||
1004 | var |
||
1005 | fn: String; |
||
1006 | LastName: String; |
||
1007 | MsgStr: String; |
||
1008 | Res: Integer; |
||
1009 | OnStatusDisk: TZMStatusDiskEvent; |
||
1010 | begin |
||
1011 | // change extn of last file |
||
1012 | LastName := RealFileName; |
||
1013 | File_Close; |
||
1014 | Result := 0; |
||
1015 | |||
1016 | if IsMultiPart then |
||
1017 | begin |
||
1018 | if ((Numbering = znsExt) and not AnsiSameText(ExtractFileExt(LastName), EXT_ZIP)) or |
||
1019 | ((Numbering = znsName) and (DiskNr = 0)) then |
||
1020 | begin |
||
1021 | Result := -1; |
||
1022 | fn := FileName; |
||
1023 | if (FileExists(fn)) then |
||
1024 | begin |
||
1025 | MsgStr := Boss.ZipFmtLoadStr(DS_AskDeleteFile, [fn]); |
||
1026 | FZipDiskStatus := FZipDiskStatus + [zdsSameFileName]; |
||
1027 | Res := idYes; |
||
1028 | if not(zaaYesOvrwrt in Worker.AnswerAll) then |
||
1029 | begin |
||
1030 | OnStatusDisk := Worker.Master.OnStatusDisk; |
||
1031 | if Assigned(OnStatusDisk) then // 1.77 |
||
1032 | begin |
||
1033 | FZipDiskAction := zdaOk; // The default action |
||
1034 | OnStatusDisk(Boss.Master, DiskNr, fn, FZipDiskStatus, |
||
1035 | FZipDiskAction); |
||
1036 | if FZipDiskAction = zdaYesToAll then |
||
1037 | begin |
||
1038 | Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt]; |
||
1039 | FZipDiskAction := zdaOk; |
||
1040 | end; |
||
1041 | if FZipDiskAction = zdaOk then |
||
1042 | Res := idYes |
||
1043 | else |
||
1044 | Res := idNo; |
||
1045 | end |
||
1046 | else |
||
1047 | Res := Boss.ZipMessageDlgEx(MsgStr, Boss.ZipLoadStr(FM_Confirm) |
||
1048 | , zmtWarning + DHC_WrtSpnDel, [mbYes, mbNo]); |
||
1049 | end; |
||
1050 | if (Res = 0) then |
||
1051 | Boss.ShowZipMessage(DS_NoMem, ''); |
||
1052 | if (Res = idNo) then |
||
1053 | Boss.ReportMsg(DS_NoRenamePart, [LastName]); |
||
1054 | if (Res = idYes) then |
||
1055 | SysUtils.DeleteFile(fn); // if it exists delete old one |
||
1056 | end; |
||
1057 | if FileExists(LastName) then // should be there but ... |
||
1058 | begin |
||
1059 | RenameFile(LastName, fn); |
||
1060 | Result := 0; |
||
1061 | if Boss.Verbosity >= zvVerbose then |
||
1062 | Boss.Diag(Format('renamed %s to %s', [LastName, fn])); |
||
1063 | end; |
||
1064 | end; |
||
1065 | end; |
||
1066 | end; |
||
1067 | |||
1068 | procedure TZMWorkFile.FlushDiskBuffer; |
||
1069 | var |
||
1070 | did: Integer; |
||
1071 | Len: Integer; |
||
1072 | begin |
||
1073 | Len := fBufferPosition; |
||
1074 | fBufferPosition := -1; // stop retrying on error |
||
1075 | if fDiskBuffer <> nil then |
||
1076 | begin |
||
1077 | Boss.KeepAlive; |
||
1078 | Boss.CheckCancel; |
||
1079 | if Len > 0 then |
||
1080 | begin |
||
1081 | repeat |
||
1082 | did := DoFileWrite(fDiskBuffer[0], Len); |
||
1083 | if did <> Len then |
||
1084 | begin |
||
1085 | NewFlushDisk; // abort or try again on new disk |
||
1086 | end; |
||
1087 | until (did = Len); |
||
1088 | end; |
||
1089 | fDiskBuffer := nil; |
||
1090 | end; |
||
1091 | end; |
||
1092 | |||
1093 | function TZMWorkFile.GetConfirmErase: Boolean; |
||
1094 | begin |
||
1095 | Result := Worker.ConfirmErase; |
||
1096 | end; |
||
1097 | |||
1098 | function TZMWorkFile.GetExists: Boolean; |
||
1099 | begin |
||
1100 | Result := false; |
||
1101 | if FileExists(FileName) then |
||
1102 | Result := True; |
||
1103 | end; |
||
1104 | |||
1105 | function TZMWorkFile.GetFileInformation(var FileInfo: |
||
1106 | _BY_HANDLE_FILE_INFORMATION): Boolean; |
||
1107 | begin |
||
1108 | Result := IsOpen; |
||
1109 | if Result then |
||
1110 | Result := GetFileInformationByHandle(Handle, FileInfo); |
||
1111 | if not Result then |
||
1112 | ZeroMemory(@FileInfo, sizeof(_BY_HANDLE_FILE_INFORMATION)); |
||
1113 | end; |
||
1114 | |||
1115 | function TZMWorkFile.GetKeepFreeOnAllDisks: Cardinal; |
||
1116 | begin |
||
1117 | Result := Worker.KeepFreeOnAllDisks; |
||
1118 | end; |
||
1119 | |||
1120 | function TZMWorkFile.GetKeepFreeOnDisk1: Cardinal; |
||
1121 | begin |
||
1122 | Result := Worker.KeepFreeOnDisk1; |
||
1123 | end; |
||
1124 | |||
1125 | function TZMWorkFile.GetLastWritten: Cardinal; |
||
1126 | var |
||
1127 | ft: TFileTime; |
||
1128 | begin |
||
1129 | Result := 0; |
||
1130 | if IsOpen and LastWriteTime(ft) then |
||
1131 | Result := FileTimeToLocalDOSTime(ft); |
||
1132 | end; |
||
1133 | |||
1134 | function TZMWorkFile.GetMaxVolumeSize: Int64; |
||
1135 | begin |
||
1136 | Result := Worker.MaxVolumeSize; |
||
1137 | end; |
||
1138 | |||
1139 | function TZMWorkFile.GetMinFreeVolumeSize: Cardinal; |
||
1140 | begin |
||
1141 | Result := Worker.MinFreeVolumeSize; |
||
1142 | end; |
||
1143 | |||
1144 | procedure TZMWorkFile.GetNewDisk(DiskSeq: Integer; AllowEmpty: Boolean); |
||
1145 | begin |
||
1146 | File_Close; |
||
1147 | // Close the file on the old disk first. |
||
1148 | if (TotalDisks <> 1) or (DiskSeq <> 0) then |
||
1149 | IsMultiPart := True; |
||
1150 | DiskNr := DiskSeq; |
||
1151 | while True do |
||
1152 | begin |
||
1153 | repeat |
||
1154 | NewDisk := True; |
||
1155 | File_Close; |
||
1156 | CheckForDisk(false, spTryFormat in SpanOptions); |
||
1157 | if AllowEmpty and WorkDrive.HasMedia(spTryFormat in SpanOptions) then |
||
1158 | begin |
||
1159 | if WorkDrive.VolumeSpace = -1 then |
||
1160 | exit; // unformatted |
||
1161 | if WorkDrive.VolumeSpace = WorkDrive.VolumeSize then |
||
1162 | exit; // empty |
||
1163 | end; |
||
1164 | until IsRightDisk; |
||
1165 | |||
1166 | if Boss.Verbosity >= zvVerbose then |
||
1167 | Boss.Diag(Boss.ZipFmtLoadStr(TM_GetNewDisk, [FileName])); |
||
1168 | if File_Open(fmShareDenyWrite or fmOpenRead) then |
||
1169 | break; // found |
||
1170 | if WorkDrive.DriveIsFixed then |
||
1171 | raise EZipMaster.CreateResDisp(DS_NoInFile, True) |
||
1172 | else |
||
1173 | Boss.ShowZipMessage(DS_NoInFile, ''); |
||
1174 | end; |
||
1175 | end; |
||
1176 | |||
1177 | function TZMWorkFile.GetPosition: Int64; |
||
1178 | begin |
||
1179 | if fDiskBuffer <> nil then |
||
1180 | Result := fBufferPosition |
||
1181 | else |
||
1182 | Result := GetPosition_F; |
||
1183 | end; |
||
1184 | |||
1185 | function TZMWorkFile.GetPosition_F: Int64; |
||
1186 | begin |
||
1187 | Result := FileSeek64(fHandle, 0, soFromCurrent); // from current |
||
1188 | end; |
||
1189 | |||
1190 | function TZMWorkFile.GetSpanOptions: TZMSpanOpts; |
||
1191 | begin |
||
1192 | Result := Worker.SpanOptions; |
||
1193 | end; |
||
1194 | |||
1195 | function TZMWorkFile.HasSpanSig(const FName: String): boolean; |
||
1196 | var |
||
1197 | fs: TFileStream; |
||
1198 | Sg: Cardinal; |
||
1199 | begin |
||
1200 | Result := False; |
||
1201 | if FileExists(FName) then |
||
1202 | begin |
||
1203 | fs := TFileStream.Create(FName, fmOpenRead); |
||
1204 | try |
||
1205 | if (fs.Size > (sizeof(TZipLocalHeader) + sizeof(Sg))) and |
||
1206 | (fs.Read(Sg, sizeof(Sg)) = sizeof(Sg)) then |
||
1207 | Result := (Sg = ExtLocalSig) and (fs.Read(Sg, sizeof(Sg)) = sizeof(Sg)) and |
||
1208 | (Sg = LocalFileHeaderSig); |
||
1209 | finally |
||
1210 | fs.Free; |
||
1211 | end; |
||
1212 | end; |
||
1213 | end; |
||
1214 | |||
1215 | function TZMWorkFile.IsRightDisk: Boolean; |
||
1216 | var |
||
1217 | fn: String; |
||
1218 | VName: string; |
||
1219 | begin |
||
1220 | Result := True; |
||
1221 | if (Numbering < znsName) and (not WorkDrive.DriveIsFixed) then |
||
1222 | begin |
||
1223 | VName := WorkDrive.DiskName; |
||
1224 | Boss.Diag('Checking disk ' + VName + ' need ' + VolName(DiskNr)); |
||
1225 | if (AnsiSameText(VName, VolName(DiskNr)) or AnsiSameText(VName, OldVolName(DiskNr))) and |
||
1226 | FileExists(FileName) then |
||
1227 | begin |
||
1228 | Numbering := znsVolume; |
||
1229 | Boss.Diag('found volume ' + VName); |
||
1230 | exit; |
||
1231 | end; |
||
1232 | end; |
||
1233 | fn := FileName; |
||
1234 | if Numbering = znsNone then // not known yet |
||
1235 | begin |
||
1236 | FileName := CreateMVFileNameEx(FileName, True, True); |
||
1237 | // make compat name |
||
1238 | if FileExists(FileName) then |
||
1239 | begin |
||
1240 | Numbering := znsExt; |
||
1241 | exit; |
||
1242 | end; |
||
1243 | FileName := fn; |
||
1244 | FileName := CreateMVFileNameEx(FileName, True, false); |
||
1245 | // make numbered name |
||
1246 | if FileExists(FileName) then |
||
1247 | begin |
||
1248 | Numbering := znsName; |
||
1249 | exit; |
||
1250 | end; |
||
1251 | if WorkDrive.DriveIsFixed then |
||
1252 | exit; // always true - only needed name |
||
1253 | FileName := fn; // restore |
||
1254 | Result := false; |
||
1255 | exit; |
||
1256 | end; |
||
1257 | // numbering scheme already known |
||
1258 | if Numbering = znsVolume then |
||
1259 | begin |
||
1260 | Result := false; |
||
1261 | exit; |
||
1262 | end; |
||
1263 | FileName := CreateMVFileNameEx(FileName, True, Numbering = znsExt); |
||
1264 | // fixed drive always true only needed new filename |
||
1265 | if (not WorkDrive.DriveIsFixed) and (not FileExists(FileName)) then |
||
1266 | begin |
||
1267 | FileName := fn; // restore |
||
1268 | Result := false; |
||
1269 | end; |
||
1270 | end; |
||
1271 | |||
1272 | function TZMWorkFile.LastWriteTime(var last_write: TFileTime): Boolean; |
||
1273 | var |
||
1274 | BHFInfo: TByHandleFileInformation; |
||
1275 | begin |
||
1276 | Result := false; |
||
1277 | last_write.dwLowDateTime := 0; |
||
1278 | last_write.dwHighDateTime := 0; |
||
1279 | if IsOpen then |
||
1280 | begin |
||
1281 | Result := GetFileInformationByHandle(fHandle, BHFInfo); |
||
1282 | if Result then |
||
1283 | last_write := BHFInfo.ftLastWriteTime; |
||
1284 | end; |
||
1285 | end; |
||
1286 | |||
1287 | function TZMWorkFile.MapNumbering(Opts: TZMSpanOpts): TZMSpanOpts; |
||
1288 | var |
||
1289 | spans: TZMSpanOpts; |
||
1290 | begin |
||
1291 | Result := Opts; |
||
1292 | if Numbering <> znsNone then |
||
1293 | begin |
||
1294 | // map numbering type only if known |
||
1295 | spans := Opts - [spCompatName] + [spNoVolumeName]; |
||
1296 | case Numbering of |
||
1297 | znsVolume: |
||
1298 | spans := spans - [spNoVolumeName]; |
||
1299 | znsExt: |
||
1300 | spans := spans + [spCompatName]; |
||
1301 | end; |
||
1302 | Result := spans; |
||
1303 | end; |
||
1304 | end; |
||
1305 | |||
1306 | procedure TZMWorkFile.NewFlushDisk; |
||
1307 | begin |
||
1308 | // need to allow another disk, check size, open file, name disk etc |
||
1309 | raise EZipMaster.CreateResDisp(DS_WriteError, True); |
||
1310 | end; |
||
1311 | |||
1312 | function TZMWorkFile.NewSegment: Boolean; // true to 'continue' |
||
1313 | var |
||
1314 | DiskFile: String; |
||
1315 | DiskSeq: Integer; |
||
1316 | MsgQ: String; |
||
1317 | Res: Integer; |
||
1318 | SegName: String; |
||
1319 | OnGetNextDisk: TZMGetNextDiskEvent; |
||
1320 | OnStatusDisk: TZMStatusDiskEvent; |
||
1321 | begin |
||
1322 | Result := false; |
||
1323 | // If we write on a fixed disk the filename must change. |
||
1324 | // We will get something like: FileNamexxx.zip where xxx is 001,002 etc. |
||
1325 | // if CompatNames are used we get FileName.zxx where xx is 01, 02 etc.. last .zip |
||
1326 | if Numbering = znsNone then |
||
1327 | begin |
||
1328 | if spCompatName in SpanOptions then |
||
1329 | Numbering := znsExt |
||
1330 | else if WorkDrive.DriveIsFixed or (spNoVolumeName in SpanOptions) then |
||
1331 | Numbering := znsName |
||
1332 | else |
||
1333 | Numbering := znsVolume; |
||
1334 | end; |
||
1335 | DiskFile := FileName; |
||
1336 | if Numbering <> znsVolume then |
||
1337 | DiskFile := CreateMVFileNameEx(DiskFile, false, Numbering = znsExt); |
||
1338 | CheckForDisk(True, spWipeFiles in SpanOptions); |
||
1339 | |||
1340 | OnGetNextDisk := Worker.Master.OnGetNextDisk; |
||
1341 | // Allow clearing of removeable media even if no volume names |
||
1342 | if (not WorkDrive.DriveIsFixed) and (spWipeFiles in SpanOptions) and |
||
1343 | ((FZipDiskAction = zdaErase) or not Assigned(OnGetNextDisk)) then |
||
1344 | begin |
||
1345 | // Do we want a format first? |
||
1346 | if Numbering = znsVolume then |
||
1347 | SegName := VolName(DiskNr) |
||
1348 | // default name |
||
1349 | else |
||
1350 | SegName := SZipSet + IntToStr(succ(DiskNr)); |
||
1351 | // Ok=6 NoFormat=-3, Cancel=-2, Error=-1 |
||
1352 | case ZipFormat(SegName) of |
||
1353 | // Start formating and wait until BeforeClose... |
||
1354 | - 1: |
||
1355 | raise EZipMaster.CreateResDisp(DS_Canceled, True); |
||
1356 | -2: |
||
1357 | raise EZipMaster.CreateResDisp(DS_Canceled, false); |
||
1358 | end; |
||
1359 | end; |
||
1360 | if WorkDrive.DriveIsFixed or (Numbering <> znsVolume) then |
||
1361 | DiskSeq := DiskNr + 1 |
||
1362 | else |
||
1363 | begin |
||
1364 | DiskSeq := StrToIntDef(Copy(WorkDrive.DiskName, 9, 3), 1); |
||
1365 | if DiskSeq < 0 then |
||
1366 | DiskSeq := 1; |
||
1367 | end; |
||
1368 | FZipDiskStatus := []; |
||
1369 | Res := AskOverwriteSegment(DiskFile, DiskSeq); |
||
1370 | if (Res = idYes) and (WorkDrive.DriveIsFixed) and |
||
1371 | (spCompatName in SpanOptions) and FileExists(ReqFileName) then |
||
1372 | begin |
||
1373 | Res := AskOverwriteSegment(ReqFileName, DiskSeq); |
||
1374 | if (Res = idYes) then |
||
1375 | EraseFile(ReqFileName, Worker.HowToDelete = htdFinal); |
||
1376 | end; |
||
1377 | if (Res = 0) or (Res = idCancel) or ((Res = idNo) and WorkDrive.DriveIsFixed) |
||
1378 | then |
||
1379 | raise EZipMaster.CreateResDisp(DS_Canceled, false); |
||
1380 | |||
1381 | if Res = idNo then |
||
1382 | begin // we will try again... |
||
1383 | FDiskWritten := 0; |
||
1384 | NewDisk := True; |
||
1385 | Result := True; |
||
1386 | exit; |
||
1387 | end; |
||
1388 | // Create the output file. |
||
1389 | if not File_Create(DiskFile) then |
||
1390 | begin // change proposed by Pedro Araujo |
||
1391 | MsgQ := Boss.ZipLoadStr(DS_NoOutFile); |
||
1392 | Res := Boss.ZipMessageDlgEx('', MsgQ, zmtError + DHC_SpanNoOut, |
||
1393 | [mbRetry, mbCancel]); |
||
1394 | if Res = 0 then |
||
1395 | raise EZipMaster.CreateResDisp(DS_NoMem, True); |
||
1396 | if Res <> idRetry then |
||
1397 | raise EZipMaster.CreateResDisp(DS_Canceled, false); |
||
1398 | FDiskWritten := 0; |
||
1399 | NewDisk := True; |
||
1400 | Result := True; |
||
1401 | exit; |
||
1402 | end; |
||
1403 | |||
1404 | // Get the free space on this disk, correct later if neccessary. |
||
1405 | WorkDrive.VolumeRefresh; |
||
1406 | |||
1407 | // Set the maximum number of bytes that can be written to this disk(file). |
||
1408 | // Reserve space on/in all the disk/file. |
||
1409 | if (DiskNr = 0) and (KeepFreeOnDisk1 > 0) or (KeepFreeOnAllDisks > 0) then |
||
1410 | begin |
||
1411 | if (KeepFreeOnDisk1 mod WorkDrive.VolumeSecSize) <> 0 then |
||
1412 | KeepFreeOnDisk1 := succ(KeepFreeOnDisk1 div WorkDrive.VolumeSecSize) |
||
1413 | * WorkDrive.VolumeSecSize; |
||
1414 | if (KeepFreeOnAllDisks mod WorkDrive.VolumeSecSize) <> 0 then |
||
1415 | KeepFreeOnAllDisks := succ |
||
1416 | (KeepFreeOnAllDisks div WorkDrive.VolumeSecSize) |
||
1417 | * WorkDrive.VolumeSecSize; |
||
1418 | end; |
||
1419 | AllowedSize := WorkDrive.VolumeSize - KeepFreeOnAllDisks; |
||
1420 | if (MaxVolumeSize > 0) and (MaxVolumeSize < AllowedSize) then |
||
1421 | AllowedSize := MaxVolumeSize; |
||
1422 | // Reserve space on/in the first disk(file). |
||
1423 | if DiskNr = 0 then |
||
1424 | AllowedSize := AllowedSize - KeepFreeOnDisk1; |
||
1425 | |||
1426 | // Do we still have enough free space on this disk. |
||
1427 | if AllowedSize < MinFreeVolumeSize then // No, too bad... |
||
1428 | begin |
||
1429 | OnStatusDisk := Worker.Master.OnStatusDisk; |
||
1430 | File_Close; |
||
1431 | SysUtils.DeleteFile(DiskFile); |
||
1432 | if Assigned(OnStatusDisk) then // v1.60L |
||
1433 | begin |
||
1434 | if Numbering <> znsVolume then |
||
1435 | DiskSeq := DiskNr + 1 |
||
1436 | else |
||
1437 | begin |
||
1438 | DiskSeq := StrToIntDef(Copy(WorkDrive.DiskName, 9, 3), 1); |
||
1439 | if DiskSeq < 0 then |
||
1440 | DiskSeq := 1; |
||
1441 | end; |
||
1442 | FZipDiskAction := zdaOk; // The default action |
||
1443 | FZipDiskStatus := [zdsNotEnoughSpace]; |
||
1444 | OnStatusDisk(Boss.Master, DiskSeq, DiskFile, FZipDiskStatus, |
||
1445 | FZipDiskAction); |
||
1446 | if FZipDiskAction = zdaCancel then |
||
1447 | Res := idCancel |
||
1448 | else |
||
1449 | Res := idRetry; |
||
1450 | end |
||
1451 | else |
||
1452 | begin |
||
1453 | MsgQ := Boss.ZipLoadStr(DS_NoDiskSpace); |
||
1454 | Res := Boss.ZipMessageDlgEx('', MsgQ, zmtError + DHC_SpanSpace, |
||
1455 | [mbRetry, mbCancel]); |
||
1456 | end; |
||
1457 | if Res = 0 then |
||
1458 | raise EZipMaster.CreateResDisp(DS_NoMem, True); |
||
1459 | if Res <> idRetry then |
||
1460 | raise EZipMaster.CreateResDisp(DS_Canceled, false); |
||
1461 | FDiskWritten := 0; |
||
1462 | |||
1463 | NewDisk := True; |
||
1464 | // If all this was on a HD then this wouldn't be useful but... |
||
1465 | Result := True; |
||
1466 | end |
||
1467 | else |
||
1468 | begin |
||
1469 | // ok. it fits and the file is open |
||
1470 | // Set the volume label of this disk if it is not a fixed one. |
||
1471 | if not(WorkDrive.DriveIsFixed or (Numbering <> znsVolume)) then |
||
1472 | begin |
||
1473 | if not WorkDrive.RenameDisk(VolName(DiskNr)) then |
||
1474 | raise EZipMaster.CreateResDisp(DS_NoVolume, True); |
||
1475 | end; |
||
1476 | // if it is a floppy buffer it |
||
1477 | if (not WorkDrive.DriveIsFixed) and (AllowedSize <= MaxDiskBufferSize) then |
||
1478 | begin |
||
1479 | SetLength(fDiskBuffer, AllowedSize); |
||
1480 | fBufferPosition := 0; |
||
1481 | end; |
||
1482 | end; |
||
1483 | end; |
||
1484 | |||
1485 | function TZMWorkFile.OldVolName(Part: Integer): String; |
||
1486 | begin |
||
1487 | Result := SPKBACK + ' ' + Copy(IntToStr(1001 + Part), 2, 3); |
||
1488 | end; |
||
1489 | |||
1490 | procedure TZMWorkFile.ProgReport(prog: TActionCodes; xprog: Integer; const |
||
1491 | Name: String; size: Int64); |
||
1492 | var |
||
1493 | actn: TActionCodes; |
||
1494 | msg: String; |
||
1495 | begin |
||
1496 | actn := prog; |
||
1497 | if (Name = '') and (xprog > PR_Progress) then |
||
1498 | msg := Boss.ZipLoadStr(xprog) |
||
1499 | else |
||
1500 | msg := Name; |
||
1501 | case ShowProgress of |
||
1502 | zspNone: |
||
1503 | case prog of |
||
1504 | zacItem: |
||
1505 | actn := zacNone; |
||
1506 | zacProgress: |
||
1507 | actn := zacTick; |
||
1508 | zacEndOfBatch: |
||
1509 | actn := zacTick; |
||
1510 | zacCount: |
||
1511 | actn := zacNone; |
||
1512 | zacSize: |
||
1513 | actn := zacTick; |
||
1514 | zacXItem: |
||
1515 | actn := zacNone; |
||
1516 | zacXProgress: |
||
1517 | actn := zacTick; |
||
1518 | end; |
||
1519 | zspExtra: |
||
1520 | case prog of |
||
1521 | zacItem: |
||
1522 | actn := zacNone; // do nothing |
||
1523 | zacProgress: |
||
1524 | actn := zacXProgress; |
||
1525 | zacCount: |
||
1526 | actn := zacNone; // do nothing |
||
1527 | zacSize: |
||
1528 | actn := zacXItem; |
||
1529 | end; |
||
1530 | end; |
||
1531 | if actn <> zacNone then |
||
1532 | Boss.ReportProgress(actn, xprog, msg, size); |
||
1533 | end; |
||
1534 | |||
1535 | function TZMWorkFile.Read(var Buffer; Len: Integer): Integer; |
||
1536 | var |
||
1537 | bp: PAnsiChar; |
||
1538 | SizeR: Integer; |
||
1539 | ToRead: Integer; |
||
1540 | begin |
||
1541 | try |
||
1542 | if IsMultiPart then |
||
1543 | begin |
||
1544 | ToRead := Len; |
||
1545 | if Len < 0 then |
||
1546 | ToRead := -Len; |
||
1547 | bp := @Buffer; |
||
1548 | Result := 0; |
||
1549 | while ToRead > 0 do |
||
1550 | begin |
||
1551 | SizeR := ReadFromFile(bp^, ToRead); |
||
1552 | if SizeR <> ToRead then |
||
1553 | begin |
||
1554 | // Check if we are at the end of a input disk. |
||
1555 | if SizeR < 0 then |
||
1556 | begin |
||
1557 | Result := SizeR; |
||
1558 | exit; |
||
1559 | end; |
||
1560 | // if error or (len <0 and read some) or (end segment) |
||
1561 | if ((Len < 0) and (SizeR <> 0)) or not EOS then |
||
1562 | begin |
||
1563 | Result := -DS_ReadError; |
||
1564 | exit; |
||
1565 | end; |
||
1566 | // It seems we are at the end, so get a next disk. |
||
1567 | GetNewDisk(DiskNr + 1, false); |
||
1568 | end; |
||
1569 | if SizeR > 0 then |
||
1570 | begin |
||
1571 | Inc(bp, SizeR); |
||
1572 | ToRead := ToRead - SizeR; |
||
1573 | Result := Result + SizeR; |
||
1574 | end; |
||
1575 | end; |
||
1576 | end |
||
1577 | else |
||
1578 | Result := Read_F(Buffer, Len); |
||
1579 | except |
||
1580 | on E: EZipMaster do |
||
1581 | Result := -E.ResId; |
||
1582 | on E: Exception do |
||
1583 | Result := -DS_ReadError; |
||
1584 | end; |
||
1585 | end; |
||
1586 | |||
1587 | function TZMWorkFile.ReadFromFile(var Buffer; Len: Integer): Integer; |
||
1588 | begin |
||
1589 | if Len < 0 then |
||
1590 | Len := -Len; |
||
1591 | Result := FileRead(fHandle, Buffer, Len); |
||
1592 | if Result > 0 then |
||
1593 | BytesRead := BytesRead + Len |
||
1594 | else if Result < 0 then |
||
1595 | begin |
||
1596 | Result := -DS_ReadError; |
||
1597 | end; |
||
1598 | end; |
||
1599 | |||
1600 | function TZMWorkFile.Reads(var Buffer; const Lens: array of Integer): Integer; |
||
1601 | var |
||
1602 | i: Integer; |
||
1603 | pb: PAnsiChar; |
||
1604 | r: Integer; |
||
1605 | begin |
||
1606 | Result := 0; |
||
1607 | if IsMultiPart then |
||
1608 | begin |
||
1609 | pb := @Buffer; |
||
1610 | for i := Low(Lens) to High(Lens) do |
||
1611 | begin |
||
1612 | r := Read(pb^, -Lens[i]); |
||
1613 | if r < 0 then |
||
1614 | begin |
||
1615 | Result := r; |
||
1616 | break; |
||
1617 | end; |
||
1618 | Result := Result + r; |
||
1619 | Inc(pb, r); |
||
1620 | end; |
||
1621 | end |
||
1622 | else |
||
1623 | Result := Reads_F(Buffer, Lens); |
||
1624 | end; |
||
1625 | |||
1626 | function TZMWorkFile.Reads_F(var Buffer; const Lens: array of Integer): Integer; |
||
1627 | var |
||
1628 | c: Integer; |
||
1629 | i: Integer; |
||
1630 | begin |
||
1631 | c := 0; |
||
1632 | for i := Low(Lens) to High(Lens) do |
||
1633 | c := c + Lens[i]; |
||
1634 | Result := ReadFromFile(Buffer, c); |
||
1635 | end; |
||
1636 | |||
1637 | function TZMWorkFile.ReadTo(strm: TStream; Count: Integer): Integer; |
||
1638 | const |
||
1639 | bsize = 20 * 1024; |
||
1640 | var |
||
1641 | done: Integer; |
||
1642 | sz: Integer; |
||
1643 | wbufr: array of Byte; |
||
1644 | begin |
||
1645 | Result := 0; |
||
1646 | SetLength(wbufr, bsize); |
||
1647 | while Count > 0 do |
||
1648 | begin |
||
1649 | sz := bsize; |
||
1650 | if sz > Count then |
||
1651 | sz := Count; |
||
1652 | done := Read(wbufr[0], sz); |
||
1653 | if done > 0 then |
||
1654 | begin |
||
1655 | if strm.write(wbufr[0], done) <> done then |
||
1656 | done := -DS_WriteError; |
||
1657 | end; |
||
1658 | if done <> sz then |
||
1659 | begin |
||
1660 | Result := -DS_FileError; |
||
1661 | if done < 0 then |
||
1662 | Result := done; |
||
1663 | break; |
||
1664 | end; |
||
1665 | Count := Count - sz; |
||
1666 | Result := Result + sz; |
||
1667 | end; |
||
1668 | end; |
||
1669 | |||
1670 | function TZMWorkFile.Read_F(var Buffer; Len: Integer): Integer; |
||
1671 | begin |
||
1672 | Result := ReadFromFile(Buffer, Len); |
||
1673 | end; |
||
1674 | |||
1675 | function TZMWorkFile.SaveFileInformation: Boolean; |
||
1676 | begin |
||
1677 | Result := GetFileInformation(fSavedFileInfo); |
||
1678 | end; |
||
1679 | |||
1680 | function TZMWorkFile.Seek(offset: Int64; from: Integer): Int64; |
||
1681 | begin |
||
1682 | Result := FileSeek64(fHandle, offset, from); |
||
1683 | end; |
||
1684 | |||
1685 | function TZMWorkFile.SeekDisk(Nr: Integer): Integer; |
||
1686 | begin |
||
1687 | if DiskNr <> Nr then |
||
1688 | GetNewDisk(Nr, false); |
||
1689 | Result := Nr; |
||
1690 | end; |
||
1691 | |||
1692 | procedure TZMWorkFile.SetBoss(const Value: TZMCore); |
||
1693 | begin |
||
1694 | if FBoss <> Value then |
||
1695 | begin |
||
1696 | if Value = nil then |
||
1697 | FBoss := fWorker |
||
1698 | else |
||
1699 | FBoss := Value; |
||
1700 | end; |
||
1701 | end; |
||
1702 | |||
1703 | function TZMWorkFile.SetEndOfFile: Boolean; |
||
1704 | begin |
||
1705 | if IsOpen then |
||
1706 | Result := Windows.SetEndOfFile(Handle) |
||
1707 | else |
||
1708 | Result := false; |
||
1709 | end; |
||
1710 | |||
1711 | procedure TZMWorkFile.SetFileName(const Value: String); |
||
1712 | begin |
||
1713 | if fFileName <> Value then |
||
1714 | begin |
||
1715 | if IsOpen then |
||
1716 | File_Close; |
||
1717 | fFileName := Value; |
||
1718 | WorkDrive.DriveStr := Value; |
||
1719 | end; |
||
1720 | end; |
||
1721 | |||
1722 | // dangerous - assumes file on same drive |
||
1723 | procedure TZMWorkFile.SetHandle(const Value: Integer); |
||
1724 | begin |
||
1725 | File_Close; |
||
1726 | fHandle := Value; |
||
1727 | fIsOpen := fHandle <> -1; |
||
1728 | end; |
||
1729 | |||
1730 | procedure TZMWorkFile.SetKeepFreeOnAllDisks(const Value: Cardinal); |
||
1731 | begin |
||
1732 | Worker.KeepFreeOnAllDisks := Value; |
||
1733 | end; |
||
1734 | |||
1735 | procedure TZMWorkFile.SetKeepFreeOnDisk1(const Value: Cardinal); |
||
1736 | begin |
||
1737 | Worker.KeepFreeOnDisk1 := Value; |
||
1738 | end; |
||
1739 | |||
1740 | procedure TZMWorkFile.SetMaxVolumeSize(const Value: Int64); |
||
1741 | begin |
||
1742 | Worker.MaxVolumeSize := Value; |
||
1743 | end; |
||
1744 | |||
1745 | procedure TZMWorkFile.SetMinFreeVolumeSize(const Value: Cardinal); |
||
1746 | begin |
||
1747 | Worker.MinFreeVolumeSize := Value; |
||
1748 | end; |
||
1749 | |||
1750 | procedure TZMWorkFile.SetPosition(const Value: Int64); |
||
1751 | begin |
||
1752 | Seek(Value, 0); |
||
1753 | end; |
||
1754 | |||
1755 | procedure TZMWorkFile.SetSpanOptions(const Value: TZMSpanOpts); |
||
1756 | begin |
||
1757 | Worker.SpanOptions := Value; |
||
1758 | end; |
||
1759 | |||
1760 | procedure TZMWorkFile.SetWorkDrive(const Value: TZMWorkDrive); |
||
1761 | begin |
||
1762 | if fWorkDrive <> Value then |
||
1763 | begin |
||
1764 | fWorkDrive := Value; |
||
1765 | end; |
||
1766 | end; |
||
1767 | |||
1768 | function TZMWorkFile.VerifyFileInformation: Boolean; |
||
1769 | var |
||
1770 | info: _BY_HANDLE_FILE_INFORMATION;//TWIN32FindData; |
||
1771 | begin |
||
1772 | GetFileInformation(info); |
||
1773 | Result := (info.ftLastWriteTime.dwLowDateTime = fSavedFileInfo.ftLastWriteTime.dwLowDateTime) and |
||
1774 | (info.ftLastWriteTime.dwHighDateTime = fSavedFileInfo.ftLastWriteTime.dwHighDateTime) and |
||
1775 | (info.ftCreationTime.dwLowDateTime = fSavedFileInfo.ftCreationTime.dwLowDateTime) and |
||
1776 | (info.ftCreationTime.dwHighDateTime = fSavedFileInfo.ftCreationTime.dwHighDateTime) and |
||
1777 | (info.nFileSizeLow = fSavedFileInfo.nFileSizeLow) and |
||
1778 | (info.nFileSizeHigh = fSavedFileInfo.nFileSizeHigh) and |
||
1779 | (info.nFileIndexLow = fSavedFileInfo.nFileIndexLow) and |
||
1780 | (info.nFileIndexHigh = fSavedFileInfo.nFileIndexHigh) and |
||
1781 | (info.dwFileAttributes = fSavedFileInfo.dwFileAttributes) and |
||
1782 | (info.dwVolumeSerialNumber = fSavedFileInfo.dwVolumeSerialNumber); |
||
1783 | end; |
||
1784 | |||
1785 | function TZMWorkFile.VolName(Part: Integer): String; |
||
1786 | begin |
||
1787 | Result := SPKBACK + Copy(IntToStr(1001 + Part), 2, 3); |
||
1788 | end; |
||
1789 | |||
1790 | function TZMWorkFile.WBuffer(size: Integer): pByte; |
||
1791 | begin |
||
1792 | if size < 1 then |
||
1793 | WBuf := nil |
||
1794 | else if HIGH(WBuf) < size then |
||
1795 | begin |
||
1796 | size := size or $3FF; |
||
1797 | SetLength(WBuf, size + 1); // reallocate |
||
1798 | end; |
||
1799 | Result := @WBuf[0]; |
||
1800 | end; |
||
1801 | |||
1802 | function TZMWorkFile.Write(const Buffer; Len: Integer): Integer; |
||
1803 | begin |
||
1804 | if IsMultiPart then |
||
1805 | Result := WriteSplit(Buffer, Len) |
||
1806 | else |
||
1807 | Result := Write_F(Buffer, Len); |
||
1808 | end; |
||
1809 | |||
1810 | function TZMWorkFile.WriteFrom(strm: TStream; Count: Integer): Int64; |
||
1811 | const |
||
1812 | bsize = 20 * 1024; |
||
1813 | var |
||
1814 | done: Integer; |
||
1815 | maxsize: Integer; |
||
1816 | sz: Integer; |
||
1817 | wbufr: array of Byte; |
||
1818 | begin |
||
1819 | Result := 0; |
||
1820 | SetLength(wbufr, bsize); |
||
1821 | maxsize := strm.size - strm.Position; |
||
1822 | if Count > maxsize then |
||
1823 | Count := maxsize; |
||
1824 | while Count > 0 do |
||
1825 | begin |
||
1826 | sz := bsize; |
||
1827 | if sz > Count then |
||
1828 | sz := Count; |
||
1829 | done := strm.Read(wbufr[0], sz); |
||
1830 | if done > 0 then |
||
1831 | done := Write(wbufr[0], done); // split ok? |
||
1832 | if done <> sz then |
||
1833 | begin |
||
1834 | Result := -DS_FileError; |
||
1835 | if done < 0 then |
||
1836 | Result := done; |
||
1837 | break; |
||
1838 | end; |
||
1839 | Count := Count - sz; |
||
1840 | Result := Result + sz; |
||
1841 | end; |
||
1842 | end; |
||
1843 | |||
1844 | function TZMWorkFile.Writes(const Buffer; const Lens: array of Integer) |
||
1845 | : Integer; |
||
1846 | var |
||
1847 | c: Integer; |
||
1848 | i: Integer; |
||
1849 | begin |
||
1850 | if IsMultiPart then |
||
1851 | begin |
||
1852 | c := 0; |
||
1853 | for i := Low(Lens) to High(Lens) do |
||
1854 | c := c + Lens[i]; |
||
1855 | Result := Write(Buffer, -c); |
||
1856 | end |
||
1857 | else |
||
1858 | Result := Writes_F(Buffer, Lens); |
||
1859 | end; |
||
1860 | |||
1861 | function TZMWorkFile.WriteSplit(const Buffer; ToWrite: Integer): Integer; |
||
1862 | var |
||
1863 | Buf: PAnsiChar; |
||
1864 | Len: Cardinal; |
||
1865 | MaxLen: Cardinal; |
||
1866 | MinSize: Cardinal; |
||
1867 | MustFit: Boolean; |
||
1868 | Res: Integer; |
||
1869 | begin { WriteSplit } |
||
1870 | try |
||
1871 | Result := 0; |
||
1872 | MustFit := false; |
||
1873 | if ToWrite >= 0 then |
||
1874 | begin |
||
1875 | Len := ToWrite; |
||
1876 | MinSize := 0; |
||
1877 | end |
||
1878 | else |
||
1879 | begin |
||
1880 | Len := -ToWrite; |
||
1881 | MustFit := (Len and MustFitFlag) <> 0; |
||
1882 | Len := Len and MustFitMask; |
||
1883 | MinSize := Len; |
||
1884 | end; |
||
1885 | Buf := @Buffer; |
||
1886 | Boss.KeepAlive; |
||
1887 | Boss.CheckCancel; |
||
1888 | |||
1889 | // Keep writing until error or Buffer is empty. |
||
1890 | while True do |
||
1891 | begin |
||
1892 | // Check if we have an output file already opened, if not: create one, |
||
1893 | // do checks, gather info. |
||
1894 | if (not IsOpen) then |
||
1895 | begin |
||
1896 | NewDisk := DiskNr <> 0; // allow first disk in drive |
||
1897 | if NewSegment then |
||
1898 | begin |
||
1899 | NewDisk := True; |
||
1900 | continue; |
||
1901 | end; |
||
1902 | end; |
||
1903 | |||
1904 | // Check if we have at least MinSize available on this disk, |
||
1905 | // headers are not allowed to cross disk boundaries. ( if zero than don't care.) |
||
1906 | if (MinSize <> 0) and (MinSize > AllowedSize) then |
||
1907 | begin // close this part |
||
1908 | // all parts must be same stamp |
||
1909 | if StampDate = 0 then |
||
1910 | StampDate := LastWritten; |
||
1911 | File_Close; |
||
1912 | FDiskWritten := 0; |
||
1913 | NewDisk := True; |
||
1914 | DiskNr := DiskNr + 1; // RCV270299 |
||
1915 | if not MustFit then |
||
1916 | continue; |
||
1917 | Result := MustFitError; |
||
1918 | break; |
||
1919 | end; |
||
1920 | |||
1921 | // Don't try to write more bytes than allowed on this disk. |
||
1922 | MaxLen := HIGH(Integer); |
||
1923 | if AllowedSize < MaxLen then |
||
1924 | MaxLen := Integer(AllowedSize); |
||
1925 | if Len < MaxLen then |
||
1926 | MaxLen := Len; |
||
1927 | if fDiskBuffer <> nil then |
||
1928 | begin |
||
1929 | Move(Buf^, fDiskBuffer[fBufferPosition], MaxLen); |
||
1930 | Res := MaxLen; |
||
1931 | Inc(fBufferPosition, MaxLen); |
||
1932 | end |
||
1933 | else |
||
1934 | Res := WriteToFile(Buf^, MaxLen); |
||
1935 | if Res < 0 then |
||
1936 | raise EZipMaster.CreateResDisp(DS_NoWrite, True); |
||
1937 | // A write error (disk removed?) |
||
1938 | |||
1939 | Inc(FDiskWritten, Res); |
||
1940 | Inc(Result, Res); |
||
1941 | AllowedSize := AllowedSize - MaxLen; |
||
1942 | if MaxLen = Len then |
||
1943 | break; |
||
1944 | |||
1945 | // We still have some data left, we need a new disk. |
||
1946 | if StampDate = 0 then |
||
1947 | StampDate := LastWritten; |
||
1948 | File_Close; |
||
1949 | AllowedSize := 0; |
||
1950 | FDiskWritten := 0; |
||
1951 | DiskNr := DiskNr + 1; |
||
1952 | NewDisk := True; |
||
1953 | Inc(Buf, MaxLen); |
||
1954 | Dec(Len, MaxLen); |
||
1955 | end; { while(True) } |
||
1956 | except |
||
1957 | on E: EZipMaster do |
||
1958 | begin |
||
1959 | Result := -E.ResId; |
||
1960 | end; |
||
1961 | on E: Exception do |
||
1962 | begin |
||
1963 | Result := -DS_UnknownError; |
||
1964 | end; |
||
1965 | end; |
||
1966 | end; |
||
1967 | |||
1968 | function TZMWorkFile.Writes_F(const Buffer; const Lens: array of Integer) |
||
1969 | : Integer; |
||
1970 | var |
||
1971 | c: Integer; |
||
1972 | i: Integer; |
||
1973 | begin |
||
1974 | c := 0; |
||
1975 | for i := Low(Lens) to High(Lens) do |
||
1976 | c := c + Lens[i]; |
||
1977 | Result := WriteToFile(Buffer, c); |
||
1978 | end; |
||
1979 | |||
1980 | function TZMWorkFile.WriteToFile(const Buffer; Len: Integer): Integer; |
||
1981 | begin |
||
1982 | if Len < 0 then |
||
1983 | Len := (-Len) and MustFitMask; |
||
1984 | Result := DoFileWrite(Buffer, Len); |
||
1985 | if Result > 0 then |
||
1986 | BytesWritten := BytesWritten + Len; |
||
1987 | end; |
||
1988 | |||
1989 | function TZMWorkFile.Write_F(const Buffer; Len: Integer): Integer; |
||
1990 | begin |
||
1991 | Result := WriteToFile(Buffer, Len); |
||
1992 | end; |
||
1993 | |||
1994 | function TZMWorkFile.ZipFormat(const NewName: String): Integer; |
||
1995 | var |
||
1996 | msg: String; |
||
1997 | Res: Integer; |
||
1998 | Vol: String; |
||
1999 | begin |
||
2000 | if NewName <> '' then |
||
2001 | Vol := NewName |
||
2002 | else |
||
2003 | Vol := WorkDrive.DiskName; |
||
2004 | if Length(Vol) > 11 then |
||
2005 | Vol := Copy(Vol, 1, 11); |
||
2006 | Result := -3; |
||
2007 | if WorkDrive.DriveIsFloppy then |
||
2008 | begin |
||
2009 | if (spTryFormat in SpanOptions) then |
||
2010 | Result := FormatFloppy(Application.Handle, WorkDrive.DriveStr); |
||
2011 | if Result = -3 then |
||
2012 | begin |
||
2013 | if ConfirmErase then |
||
2014 | begin |
||
2015 | msg := Boss.ZipFmtLoadStr(FM_Erase, [WorkDrive.DriveStr]); |
||
2016 | Res := Boss.ZipMessageDlgEx(Boss.ZipLoadStr(FM_Confirm), msg, |
||
2017 | zmtWarning + DHC_FormErase, [mbYes, mbNo]); |
||
2018 | if Res <> idYes then |
||
2019 | begin |
||
2020 | Result := -3; // no was -2; // cancel |
||
2021 | exit; |
||
2022 | end; |
||
2023 | end; |
||
2024 | ClearFloppy(WorkDrive.DriveStr); |
||
2025 | Result := 0; |
||
2026 | end; |
||
2027 | WorkDrive.HasMedia(false); |
||
2028 | if (Result = 0) and (Numbering = znsVolume) then |
||
2029 | WorkDrive.RenameDisk(Vol); |
||
2030 | end; |
||
2031 | end; |
||
2032 | |||
2033 | end. |