DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob


2b6960015305fb242653e590534aa1ff3b0cc28f
[d2df-editor.git] / src / shared / WADEDITOR_dfzip.pas
1 {$INCLUDE ../shared/a_modes.inc}
2
3 unit WADEDITOR_dfzip;
4
5 // Implementation restrictions:
6 // - File must start with LFH or EOCD signature
7 // - EOCD must be located strictly at the end of file
8 // - Multi-disk ZIP files are not supported
9 // - Expect UTF-8 or CP1251 encoded names
10 // - ZIP64 not supported
11 // - Encryption not supported
12 // - Zero-length file names not supported
13 // - CDR holds most actual data about file, LFH mostly ignored
14 // - Attributes, comments and extra data are ignored and not saved
15 // - Store and Deflate compression supported
16
17 interface
18
19 uses Classes, WADEDITOR;
20
21 type
22 TResource = record
23 name: AnsiString;
24 pos: UInt32;
25 csize: UInt32;
26 usize: UInt32;
27 comp: UInt32;
28 chksum: UInt32;
29 mtime: UInt32;
30 stream: TMemoryStream;
31 end;
32
33 TSection = record
34 name: AnsiString;
35 mtime: UInt32;
36 list: array of TResource;
37 end;
38
39 PResource = ^TResource;
40 PSection = ^TSection;
41
42 TZIPEditor = class sealed(WADEDITOR.TWADEditor)
43 private
44 FSection: array of TSection;
45 FStream: TStream;
46 FLastError: Integer;
47 FVersion: Byte;
48
49 function FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
50 function FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
51 function InsertSectionRAW(name: AnsiString; mtime: UInt32): PSection;
52
53 function FindSectionID(name: AnsiString): Integer;
54 function FindSection(name: AnsiString): PSection;
55 function InsertSection(name: AnsiString; mtime: UInt32): PSection;
56
57 function InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc, mtime: UInt32): PResource;
58 function Preload(p: PResource): Boolean;
59 function GetSourceStream(p: PResource): TStream;
60
61 procedure ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc, xtime: UInt32);
62 procedure ReadCDR(s: TStream; cdrid: Integer);
63 function FindEOCD(s: TStream): Boolean;
64 procedure ReadEOCD(s: TStream);
65
66 procedure WriteLFH(s: TStream; comp, mtime, crc, csize, usize: UInt32; const afname: AnsiString);
67 procedure WriteCDR(s: TStream; comp, mtime, crc, csize, usize, eattr, offset: UInt32; const afname: AnsiString; cdrid: Integer);
68 procedure SaveToStream(s: TStream);
69
70 public
71 constructor Create();
72 destructor Destroy(); override;
73 procedure FreeWAD(); override;
74 function ReadFile2(FileName: string): Boolean; override;
75 function ReadMemory(Data: Pointer; Len: LongWord): Boolean; override;
76 procedure CreateImage(); override;
77 function AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; override; overload;
78 function AddResource(FileName, Name, Section: String): Boolean; override; overload;
79 function AddAlias(Res, Alias: String): Boolean; override;
80 procedure AddSection(Name: String); override;
81 procedure RemoveResource(Section, Resource: String); override;
82 procedure SaveTo(FileName: String); override;
83 function HaveResource(Section, Resource: String): Boolean; override;
84 function HaveSection(Section: string): Boolean; override;
85 function GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; override;
86 function GetSectionList(): SArray; override;
87 function GetResourcesList(Section: String): SArray; override;
88
89 function GetLastError: Integer; override;
90 function GetLastErrorStr: String; override;
91 function GetResourcesCount: Word; override;
92 function GetVersion: Byte; override;
93 end;
94
95 implementation
96
97 uses SysUtils, StrUtils, DateUtils, Math, utils, zstream, crc, e_log;
98
99 const
100 ZIP_SIGN_CDR = 'PK'#1#2;
101 ZIP_SIGN_LFH = 'PK'#3#4;
102 ZIP_SIGN_EOCD = 'PK'#5#6;
103
104 const
105 ZIP_COMP_STORE = 0;
106 ZIP_COMP_SHRUNK = 1;
107 ZIP_COMP_REDUCE1 = 2;
108 ZIP_COMP_REDUCE2 = 3;
109 ZIP_COMP_REDUCE3 = 4;
110 ZIP_COMP_REDUCE4 = 5;
111 ZIP_COMP_IMPLODE = 6;
112 ZIP_COMP_TOKENIZED = 7;
113 ZIP_COMP_DEFLATE = 8;
114 ZIP_COMP_DEFLATE64 = 9;
115 ZIP_COMP_TERSE1 = 10;
116 ZIP_COMP_BZIP2 = 12;
117 ZIP_COMP_LZMA = 14;
118 ZIP_COMP_CMPSC = 16;
119 ZIP_COMP_TERSE2 = 18;
120 ZIP_COMP_LZ77 = 19;
121 ZIP_COMP_ZSTD1 = 20;
122 ZIP_COMP_ZSTD2 = 93;
123 ZIP_COMP_MP3 = 94;
124 ZIP_COMP_XZ = 95;
125 ZIP_COMP_JPEG = 96;
126 ZIP_COMP_WAVPACK = 97;
127 ZIP_COMP_PPMD = 98;
128 ZIP_COMP_AE = 99;
129
130 const
131 ZIP_SYSTEM = 0; // DOS / FAT
132 ZIP_MAXVERSION = 63; // Max supported version
133
134 const
135 ZIP_ENCRYPTION_MASK = (1 << 0) or (1 << 6) or (1 << 13);
136 ZIP_UTF8_MASK = (1 << 11);
137
138 function IsASCII(const s: AnsiString): Boolean;
139 var i: Integer;
140 begin
141 for i := 1 to Length(s) do
142 begin
143 if s[i] >= #$80 then
144 begin
145 Result := False;
146 exit;
147 end;
148 end;
149 Result := True;
150 end;
151
152 function IsUTF8(const s: AnsiString): Boolean;
153 var i, j, len: Integer;
154 begin
155 Result := False;
156 i := 1; len := Length(s);
157 while i <= len do
158 begin
159 case Ord(s[i]) of
160 $00..$7F: j := 0;
161 $80..$BF: exit; // invalid encoding
162 $C0..$DF: j := 1;
163 $E0..$EF: j := 2;
164 $F0..$F7: j := 3;
165 otherwise exit; // invalid encoding
166 end;
167 Inc(i);
168 while j > 0 do
169 begin
170 if i > len then exit; // invlid length
171 case Ord(s[i]) of
172 $80..$BF: ; // ok
173 else exit; // invalid encoding
174 end;
175 Inc(i);
176 Dec(j);
177 end;
178 end;
179 Result := True;
180 end;
181
182 function DosToStr(dostime: UInt32): AnsiString;
183 begin
184 try
185 DateTimeToString(Result, 'yyyy/mm/dd hh:nn:ss', DosDateTimeToDateTime(dostime));
186 except on e: EConvertError do
187 Result := 'INVALID ($' + IntToHex(dostime, 8) + ')';
188 end;
189 end;
190
191 procedure ToSectionFile(fname: AnsiString; out section, name: AnsiString); inline;
192 var i: SizeInt;
193 begin
194 i := LastDelimiter('/', fname);
195 section := Copy(fname, 1, i - 1);
196 name := Copy(fname, i + 1)
197 end;
198
199 function GetFileName(const Section, Name: AnsiString): AnsiString; inline;
200 begin
201 if Section = '' then
202 Result := Name
203 else
204 Result := Section + '/' + Name;
205 end;
206
207 function PrepString(const s: AnsiString; caseSensitive, extSensitive: Boolean): AnsiString; inline;
208 var i: Integer;
209 begin
210 Result := s;
211 if caseSensitive = False then
212 begin
213 Result := UpperCase(Result);
214 end;
215 if extSensitive = False then
216 begin
217 i := Pos('.', Result); // fix dotfiles
218 if i > 1 then
219 SetLength(Result, i - 1);
220 end;
221 end;
222
223 function FindResourceIDRAW(p: PSection; name: AnsiString; caseSensitive, extSensitive: Boolean): Integer;
224 var i: Integer; pname: AnsiString;
225 begin
226 if p <> nil then
227 begin
228 pname := PrepString(name, caseSensitive, extSensitive);
229 for i := 0 to High(p.list) do
230 begin
231 if PrepString(p.list[i].name, caseSensitive, extSensitive) = pname then
232 begin
233 Result := i;
234 exit;
235 end;
236 end;
237 end;
238 Result := -1;
239 end;
240
241 function FindResourceID(p: PSection; name: AnsiString): Integer;
242 var i: Integer;
243 begin
244 i := FindResourceIDRAW(p, name, True, True); // CaSeNaMe.Ext
245 if i < 0 then
246 begin
247 i := FindResourceIDRAW(p, name, False, True); // CASENAME.EXT
248 if i < 0 then
249 begin
250 i := FindResourceIDRAW(p, name, True, False); // CaSeNaMe
251 if i < 0 then
252 begin
253 i := FindResourceIDRAW(p, name, False, False); // CASENAME
254 end;
255 end;
256 end;
257 Result := i;
258 end;
259
260 function FindResource(p: PSection; name: AnsiString): PResource;
261 var i: Integer;
262 begin
263 i := FindResourceID(p, name);
264 if i >= 0 then
265 Result := @p.list[i]
266 else
267 Result := nil;
268 end;
269
270
271
272 function TZIPEditor.FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
273 var i: Integer; pname: AnsiString;
274 begin
275 if FSection <> nil then
276 begin
277 pname := PrepString(name, caseSensitive, True);
278 for i := 0 to High(FSection) do
279 begin
280 if PrepString(FSection[i].name, caseSensitive, True) = pname then
281 begin
282 Result := i;
283 exit;
284 end;
285 end;
286 end;
287 Result := -1;
288 end;
289
290 function TZIPEditor.FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
291 var i: Integer;
292 begin
293 i := FindSectionIDRAW(name, caseSensitive);
294 if i >= 0 then
295 Result := @FSection[i]
296 else
297 Result := nil;
298 end;
299
300 function TZIPEditor.InsertSectionRAW(name: AnsiString; mtime: UInt32): PSection;
301 var i: Integer;
302 begin
303 if FSection = nil then i := 0 else i := Length(FSection);
304 SetLength(FSection, i + 1);
305 FSection[i] := Default(TSection);
306 FSection[i].name := name;
307 FSection[i].mtime := mtime;
308 Result := @FSection[i];
309 end;
310
311
312
313 function TZIPEditor.FindSectionID(name: AnsiString): Integer;
314 var fixName: AnsiString;
315 begin
316 fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
317 Result := FindSectionIDRAW(fixName, True); // CaSeNaMe
318 if Result < 0 then
319 Result := FindSectionIDRAW(fixName, False); // CASENAME
320 end;
321
322 function TZIPEditor.FindSection(name: AnsiString): PSection;
323 var fixName: AnsiString;
324 begin
325 fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
326 Result := FindSectionRAW(fixName, True); // CaSeNaMe
327 if Result = nil then
328 Result := FindSectionRAW(fixName, False); // CASENAME
329 end;
330
331 function TZIPEditor.InsertSection(name: AnsiString; mtime: UInt32): PSection;
332 begin
333 Result := FindSection(name);
334 if Result = nil then
335 Result := InsertSectionRAW(name, mtime);
336 end;
337
338
339
340 function TZIPEditor.InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc, mtime: UInt32): PResource;
341 var p: PSection; i: Integer;
342 begin
343 p := FindSectionRAW(section, True);
344 if p = nil then
345 p := InsertSectionRAW(section, mtime);
346 if p.list = nil then i := 0 else i := Length(p.list);
347 SetLength(p.list, i + 1);
348 p.list[i] := Default(TResource);
349 p.list[i].name := name;
350 p.list[i].pos := pos;
351 p.list[i].csize := csize;
352 p.list[i].usize := usize;
353 p.list[i].comp := comp;
354 p.list[i].chksum := crc;
355 p.list[i].mtime := mtime;
356 p.list[i].stream := nil;
357 Result := @p.list[i];
358 end;
359
360
361
362 function TZIPEditor.AddAlias(Res, Alias: String): Boolean;
363 begin
364 // Hard-links not supported in ZIP
365 // However, they never created by editor
366 Result := False;
367 end;
368
369 function TZIPEditor.AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean;
370 const compress: Boolean = True;
371 const level: TCompressionLevel = TCompressionLevel.clMax;
372 var s: TMemoryStream; cs: TCompressionStream; p: PResource;
373 var comp, crc: UInt32;
374 begin
375 Name := win2utf(Name);
376 Section := win2utf(Section);
377 Result := False;
378 if Name <> '' then
379 begin
380 s := TMemoryStream.Create();
381 try
382 if compress and (Len > 0) then
383 begin
384 cs := TCompressionStream.Create(level, s, True);
385 try
386 cs.WriteBuffer(PByte(Data)[0], Len);
387 cs.Flush();
388 comp := ZIP_COMP_DEFLATE;
389 finally
390 cs.Free();
391 end;
392 end;
393 if (Len = 0) or (compress = False) or (s.Size >= Len) then
394 begin
395 s.Seek(0, TSeekOrigin.soBeginning);
396 s.SetSize(Len);
397 s.WriteBuffer(PByte(Data)[0], Len);
398 comp := ZIP_COMP_STORE;
399 Assert(s.Size = Len);
400 end;
401 crc := crc32(0, nil, 0);
402 crc := crc32(crc, data, len);
403 p := InsertFileInfo(Section, Name, $ffffffff, s.Size, Len, comp, crc, DateTimeToDosDateTime(Now()));
404 p.stream := s;
405 Result := True;
406 except
407 s.Free();
408 raise;
409 end;
410 end;
411 end;
412
413 function TZIPEditor.AddResource(FileName, Name, Section: String): Boolean;
414 var s: TFileStream; ptr: PByte;
415 begin
416 Result := False;
417 FLastError := DFWAD_ERROR_READWAD;
418 try
419 s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
420 try
421 GetMem(ptr, s.Size);
422 try
423 s.ReadBuffer(ptr[0], s.Size);
424 Result := AddResource(ptr, s.Size, Name, Section);
425 if Result = True then FLastError := DFWAD_NOERROR;
426 finally
427 FreeMem(ptr);
428 end;
429 finally
430 s.Free();
431 end;
432 except
433 on e: EFOpenError do
434 begin
435 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
436 e_WriteLog('DFZIP: AddResource: failed to open file ' + FileName, MSG_NOTIFY);
437 FLastError := DFWAD_ERROR_CANTOPENWAD;
438 end;
439 end;
440 end;
441
442 constructor TZIPEditor.Create();
443 begin
444 FSection := nil;
445 FStream := nil;
446 FLastError := DFWAD_NOERROR;
447 FVersion := 10;
448 FreeWAD();
449 end;
450
451 destructor TZIPEditor.Destroy();
452 begin
453 FreeWAD();
454 inherited;
455 end;
456
457 procedure TZIPEditor.FreeWAD();
458 var i, j: Integer;
459 begin
460 if FSection <> nil then
461 begin
462 for i := 0 to High(FSection) do
463 begin
464 if FSection[i].list <> nil then
465 begin
466 for j := 0 to High(FSection[i].list) do
467 begin
468 if FSection[i].list[j].stream <> nil then
469 begin
470 FreeAndNil(FSection[i].list[j].stream);
471 end;
472 end;
473 SetLength(FSection[i].list, 0);
474 end;
475 end;
476 SetLength(FSection, 0);
477 end;
478 if FStream <> nil then
479 begin
480 FreeAndNil(FStream);
481 end;
482 FLastError := DFWAD_NOERROR;
483 FVersion := 10;
484 end;
485
486 function TZIPEditor.Preload(p: PResource): Boolean;
487 var s: TMemoryStream;
488 begin
489 Result := False;
490 if p <> nil then
491 begin
492 Result := p.stream <> nil;
493 if (p.stream = nil) and (FStream <> nil) then
494 begin
495 s := TMemoryStream.Create();
496 try
497 if p.csize > 0 then
498 begin
499 FStream.Seek(p.pos, TSeekOrigin.soBeginning);
500 s.CopyFrom(FStream, p.csize);
501 end;
502 Assert(s.Size = p.csize); // wtf, random size if copied zero bytes!
503 p.stream := s;
504 Result := True;
505 except
506 s.Free();
507 end;
508 end;
509 end;
510 end;
511
512 procedure TZIPEditor.CreateImage();
513 var i, j: Integer;
514 begin
515 if FStream = nil then
516 begin
517 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
518 e_WriteLog('DFZIP: CreateImage: File not assigned', MSG_NOTIFY);
519 FLastError := DFWAD_ERROR_WADNOTLOADED;
520 end
521 else if FStream is TMemoryStream then
522 begin
523 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
524 e_WriteLog('DFZIP: CreateImage: Memory stream', MSG_NOTIFY);
525 FLastError := DFWAD_NOERROR;
526 end
527 else
528 begin
529 if FSection <> nil then
530 begin
531 for i := 0 to High(FSection) do
532 begin
533 if FSection[i].list <> nil then
534 begin
535 for j := 0 to High(FSection[i].list) do
536 begin
537 if Preload(@FSection[i].list[j]) = False then
538 begin
539 if gWADEditorLogLevel >= DFWAD_LOG_WARN then
540 e_WriteLog('DFZIP: CreateImage: failed to preload resource [' + FSection[i].name + '][' + FSection[i].list[j].name + ']', MSG_WARNING);
541 FLastError := DFWAD_ERROR_CANTOPENWAD;
542 exit;
543 end;
544 end;
545 end;
546 end;
547 end;
548 FreeAndNil(FStream);
549 FLastError := DFWAD_NOERROR;
550 end;
551 end;
552
553 procedure TZIPEditor.AddSection(Name: String);
554 begin
555 Name := win2utf(Name);
556 if InsertSection(Name, DateTimeToDosDateTime(Now())) = nil then
557 raise Exception.Create('DFZIP: AddSection[' + Name + ']: failed to insert');
558 end;
559
560 function TZIPEditor.HaveResource(Section, Resource: String): Boolean;
561 begin
562 Section := win2utf(Section);
563 Resource := win2utf(Resource);
564 Result := FindResource(FindSection(Section), Resource) <> nil;
565 end;
566
567 function TZIPEditor.HaveSection(Section: String): Boolean;
568 begin
569 Section := win2utf(Section);
570 Result := FindSection(Section) <> nil;
571 end;
572
573 function TZIPEditor.GetSourceStream(p: PResource): TStream;
574 var src: TStream;
575 begin
576 src := nil;
577 if p.stream <> nil then
578 begin
579 src := p.stream;
580 src.Seek(0, TSeekOrigin.soBeginning);
581 end
582 else if FStream <> nil then
583 begin
584 src := FStream;
585 src.Seek(p.pos, TSeekOrigin.soBeginning);
586 end;
587 Result := src;
588 end;
589
590 function TZIPEditor.GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean;
591 var p: PResource; ptr: PByte; src: TStream; tmp: TDecompressionStream; crc: UInt32;
592 begin
593 Section := win2utf(Section);
594 Resource := win2utf(Resource);
595 FLastError := DFWAD_ERROR_CANTOPENWAD;
596 Result := False;
597 pData := nil;
598 Len := 0;
599 p := FindResource(FindSection(Section), Resource);
600 if p <> nil then
601 begin
602 src := GetSourceStream(p);
603 if src <> nil then
604 begin
605 case p.comp of
606 ZIP_COMP_STORE:
607 begin
608 Assert(p.csize = p.usize);
609 GetMem(ptr, p.usize);
610 try
611 try
612 src.ReadBuffer(ptr[0], p.usize);
613 Result := True;
614 except
615 FreeMem(ptr);
616 raise;
617 end;
618 except on e: EReadError do
619 if gWADEditorLogLevel >= DFWAD_LOG_WARN then
620 e_WriteLog('DFZIP: Failed to read STOREd data, reason: ' + e.Message, MSG_WARNING);
621 end;
622 end;
623 ZIP_COMP_DEFLATE:
624 try
625 tmp := TDecompressionStream.Create(src, True);
626 try
627 GetMem(ptr, p.usize);
628 try
629 tmp.ReadBuffer(ptr[0], p.usize);
630 Result := True;
631 except
632 FreeMem(ptr);
633 raise;
634 end;
635 finally
636 tmp.Free();
637 end;
638 except
639 on e: EStreamError do
640 begin
641 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
642 e_WriteLog('DFZIP: Failed to decompress DEFLATEd data, reason: ' + e.Message, MSG_WARNING);
643 raise e;
644 end;
645 end;
646 otherwise
647 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
648 e_WriteLog('DFZIP: Unsupported compression method: ' + IntToStr(p.comp), MSG_WARNING);
649 end;
650 end
651 else
652 begin
653 if gWADEditorLogLevel >= DFWAD_LOG_WARN then
654 e_WriteLog('DFZIP: No available source for file data', MSG_WARNING);
655 FLastError := DFWAD_ERROR_WADNOTLOADED;
656 end;
657 if Result = True then
658 begin
659 crc := crc32(0, nil, 0);
660 crc := crc32(crc, ptr, p.usize);
661 Result := crc = p.chksum;
662 if Result = True then
663 begin
664 pData := ptr;
665 Len := p.usize;
666 FLastError := DFWAD_NOERROR;
667 end
668 else
669 begin
670 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
671 e_WriteLog('DFZIP: File integrity check failed: expected CRC32 $' + IntToHex(p.chksum, 8) + ', calculated CRC32 $' + IntToHex(crc, 8), MSG_WARNING);
672 FreeMem(ptr);
673 end;
674 end;
675 end
676 else
677 begin
678 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
679 e_WriteLog('DFZIP: Resource not found', MSG_NOTIFY);
680 FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
681 end;
682 end;
683
684 function TZIPEditor.GetResourcesList(Section: String): SArray;
685 var p: PSection; i: Integer;
686 begin
687 Section := win2utf(Section);
688 Result := nil;
689 p := FindSection(Section);
690 if (p <> nil) and (p.list <> nil) then
691 begin
692 SetLength(Result, Length(p.list));
693 for i := 0 to High(p.list) do
694 begin
695 Result[i] := utf2win(p.list[i].name);
696 end;
697 end;
698 end;
699
700 function TZIPEditor.GetSectionList(): SArray;
701 var i: Integer;
702 begin
703 Result := nil;
704 if FSection <> nil then
705 begin
706 SetLength(Result, Length(FSection));
707 for i := 0 to High(FSection) do
708 begin
709 Result[i] := utf2win(FSection[i].name);
710 end;
711 end;
712 end;
713
714 procedure TZIPEditor.ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc, xtime: UInt32);
715 var sig: packed array [0..3] of Char;
716 var va, vb, flags, comp: UInt16;
717 var mtime, crc, csize, usize: UInt32;
718 var fnlen, extlen: UInt16;
719 var mypos, datapos: UInt64;
720 var section, name: AnsiString;
721 var p: Pointer;
722 begin
723 mypos := s.Position;
724 if mypos + 30 <= s.Size then
725 begin
726 s.ReadBuffer(sig[0], 4);
727 if sig = ZIP_SIGN_LFH then
728 begin
729 va := s.ReadByte(); // Min Version
730 vb := s.ReadByte(); // Min System
731 flags := LEtoN(s.ReadWord());
732 comp := LEtoN(s.ReadWord());
733 mtime := LEtoN(s.ReadDWord());
734 crc := LEtoN(s.ReadDWord());
735 csize := LEtoN(s.ReadDWord());
736 usize := LEtoN(s.ReadDWord());
737 fnlen := LEtoN(s.ReadWord());
738 extlen := LEtoN(s.ReadWord());
739 datapos := s.Position + fnlen + extlen;
740 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
741 begin
742 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Min Version : ' + IntToStr(va), MSG_NOTIFY);
743 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Min System : ' + IntToStr(vb), MSG_NOTIFY);
744 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Flags : $' + IntToHex(flags, 4), MSG_NOTIFY);
745 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Compression : ' + IntToStr(comp), MSG_NOTIFY);
746 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Modification Time : ' + DosToStr(mtime), MSG_NOTIFY);
747 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': CRC-32 : $' + IntToHex(crc, 8), MSG_NOTIFY);
748 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Compressed size : ' + IntToStr(csize), MSG_NOTIFY);
749 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
750 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Name Length : ' + IntToStr(fnlen), MSG_NOTIFY);
751 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Extension Length : ' + IntToStr(extlen), MSG_NOTIFY);
752 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': <DATA OFFSET> : $' + IntToHex(datapos, 8), MSG_NOTIFY);
753 end;
754 if (va >= 10) and (va <= ZIP_MAXVERSION) then
755 begin
756 if datapos + xcsize <= s.Size then
757 begin
758 ToSectionFile(fname, section, name);
759 if name = '' then
760 begin
761 p := FindSectionRAW(section, True);
762 if p = nil then
763 p := InsertSectionRAW(section, xtime);
764 end
765 else
766 begin
767 p := InsertFileInfo(section, name, datapos, xcsize, xusize, xcomp, xcrc, xtime);
768 end;
769 if p = nil then
770 raise Exception.Create('Failed to register resource [' + fname + ']');
771 end
772 else
773 raise Exception.Create('Invalid LFH size (corrupted file?)');
774 end
775 else
776 begin
777 FLastError := DFWAD_ERROR_WRONGVERSION;
778 raise Exception.Create('Unsupported CDR version ' + IntToStr(va) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION) + ']');
779 end;
780 end
781 else
782 raise Exception.Create('Invalid LFH signature $' +IntToHex(Ord(sig[0]), 2) + ' $' +IntToHex(Ord(sig[1]), 2) + ' $' +IntToHex(Ord(sig[2]), 2) + ' $' +IntToHex(Ord(sig[3]), 2) + ' (corrupted file?)');
783 end
784 else
785 raise Exception.Create('Invalid LFH size (corrupted file?)');
786 end;
787
788 procedure TZIPEditor.ReadCDR(s: TStream; cdrid: Integer);
789 var sig: packed array [0..3] of Char;
790 var vva, vvb, va, vb, flags, comp: UInt16;
791 var mtime, crc, csize, usize: UInt32;
792 var fnlen, extlen, comlen, disk, iattr: UInt16;
793 var eattr, offset: UInt32;
794 var mypos, next: UInt64;
795 var name: PChar;
796 var aname: AnsiString;
797 var cvtbug, utf8: Boolean;
798 begin
799 mypos := s.Position;
800 s.ReadBuffer(sig[0], 4);
801 if sig = ZIP_SIGN_CDR then
802 begin
803 // Valid Central Directory Signature
804 vva := s.ReadByte(); // Writer Version
805 vvb := s.ReadByte(); // Writer System
806 va := s.ReadByte(); // Min Version
807 vb := s.ReadByte(); // Min System
808 flags := LEtoN(s.ReadWord());
809 comp := LEtoN(s.ReadWord());
810 mtime := LEtoN(s.ReadDWord());
811 crc := LEtoN(s.ReadDWord());
812 csize := LEtoN(s.ReadDWord());
813 usize := LEtoN(s.ReadDWord());
814 fnlen := LEtoN(s.ReadWord());
815 extlen := LEtoN(s.ReadWord());
816 comlen := LEtoN(s.ReadWord());
817 disk := LEtoN(s.ReadWord());
818 iattr := LEtoN(s.ReadWord());
819 eattr := LEtoN(s.ReadDWord());
820 offset := LEtoN(s.ReadDWord());
821 next := s.Position + fnlen + extlen + comlen;
822 FVersion := va;
823 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
824 begin
825 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer Version : ' + IntToStr(vva), MSG_NOTIFY);
826 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer System : ' + IntToStr(vvb), MSG_NOTIFY);
827 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min Version : ' + IntToStr(va), MSG_NOTIFY);
828 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min System : ' + IntToStr(vb), MSG_NOTIFY);
829 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Flags : $' + IntToHex(flags, 4), MSG_NOTIFY);
830 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compression : ' + IntToStr(comp), MSG_NOTIFY);
831 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Modification Time : ' + DosToStr(mtime), MSG_NOTIFY);
832 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': CRC-32 : $' + IntToHex(crc, 8), MSG_NOTIFY);
833 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compressed size : ' + IntToStr(csize), MSG_NOTIFY);
834 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
835 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name Length : ' + IntToStr(fnlen), MSG_NOTIFY);
836 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Extension Length : ' + IntToStr(extlen), MSG_NOTIFY);
837 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Comment Length : ' + IntToStr(comlen), MSG_NOTIFY);
838 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Disk : ' + IntToStr(disk), MSG_NOTIFY);
839 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Internal Attrib : $' + IntToHex(iattr, 4), MSG_NOTIFY);
840 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': External Attrib : $' + IntToHex(eattr, 8), MSG_NOTIFY);
841 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': LFH Offset : $' + IntToHex(offset, 8), MSG_NOTIFY);
842 end;
843 cvtbug := False;
844 if (vva = $10) and (vvb = $0A) and (va = $10) and (vb = $00) and (flags = (1 << 10)) and (mtime = 0) and (iattr = 0) and (eattr = 0) then
845 begin
846 // HACK: Editor and wadcvt for long time sets incorrent flag for UTF-8
847 flags := ZIP_UTF8_MASK;
848 cvtbug := True;
849 end;
850 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
851 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': WADCVT BUG : ' + BoolToStr(cvtbug, True), MSG_NOTIFY);
852 if (va >= 10) and (va <= ZIP_MAXVERSION) then
853 begin
854 if (flags and ZIP_ENCRYPTION_MASK) = 0 then
855 begin
856 if (csize <> $ffffffff) and (usize <> $ffffffff) and (disk <> $ffff) and (offset <> $ffffffff) then
857 begin
858 if disk = 0 then
859 begin
860 if (next <= s.Size) and (fnlen > 0) then
861 begin
862 case comp of
863 ZIP_COMP_STORE:
864 if csize <> usize then
865 raise Exception.Create('Compressed size ' + IntToStr(csize) + ' != Descompressed size ' + IntToStr(usize) + 'for STORE method (corrupted file?)');
866 ZIP_COMP_SHRUNK,
867 ZIP_COMP_REDUCE1,
868 ZIP_COMP_REDUCE2,
869 ZIP_COMP_REDUCE3,
870 ZIP_COMP_REDUCE4,
871 ZIP_COMP_IMPLODE,
872 ZIP_COMP_DEFLATE,
873 ZIP_COMP_DEFLATE64,
874 ZIP_COMP_TERSE1,
875 ZIP_COMP_BZIP2,
876 ZIP_COMP_LZMA,
877 ZIP_COMP_CMPSC,
878 ZIP_COMP_TERSE2,
879 ZIP_COMP_LZ77,
880 ZIP_COMP_ZSTD1,
881 ZIP_COMP_ZSTD2,
882 ZIP_COMP_MP3,
883 ZIP_COMP_XZ,
884 ZIP_COMP_JPEG,
885 ZIP_COMP_WAVPACK,
886 ZIP_COMP_PPMD:
887 ; // ok
888 ZIP_COMP_AE:
889 raise Exception.Create('Encrypted archives not supported');
890 otherwise
891 raise Exception.Create('Unknown compression method ' + IntToStr(comp));
892 end;
893 GetMem(name, UInt32(fnlen) + 1);
894 try
895 s.ReadBuffer(name[0], fnlen);
896 name[fnlen] := #0;
897 aname := name;
898 utf8 := True;
899 if (flags and ZIP_UTF8_MASK = 0) and (IsUTF8(name) = False) then
900 begin
901 aname := win2utf(aname);
902 utf8 := False;
903 end;
904 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
905 begin
906 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': UTF-8 Comatible : ' + BoolToStr(utf8, True), MSG_NOTIFY);
907 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name : "' + aname + '"', MSG_NOTIFY);
908 end;
909 s.Seek(offset, TSeekOrigin.soBeginning);
910 ReadLFH(s, aname, csize, usize, comp, crc, mtime);
911 finally
912 s.Seek(next, TSeekOrigin.soBeginning);
913 FreeMem(name);
914 end;
915 end
916 else
917 raise Exception.Create('Empty files names not supported');
918 end
919 else
920 raise Exception.Create('Splitted archives not supported');
921 end
922 else
923 begin
924 FLastError := DFWAD_ERROR_WRONGVERSION;
925 raise Exception.Create('ZIP64 not supported');
926 end;
927 end
928 else
929 begin
930 FLastError := DFWAD_ERROR_READWAD;
931 raise Exception.Create('Encrypted archives not supported');
932 end;
933 end
934 else
935 begin
936 FLastError := DFWAD_ERROR_WRONGVERSION;
937 raise Exception.Create('Unsupported CDR version ' + IntToStr(va) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION) + ']');
938 end;
939 end
940 else
941 raise Exception.Create('Invalid CDR signature $' + IntToHex(Ord(sig[0]), 2) + ' $' +IntToHex(Ord(sig[1]), 2) + ' $' +IntToHex(Ord(sig[2]), 2) + ' $' +IntToHex(Ord(sig[3]), 2) + ' (corrupted file?)');
942 end;
943
944 function TZIPEditor.FindEOCD(s: TStream): Boolean;
945 const maxedir = 20; // end of central directory entry
946 const maxecdir = maxedir + 65536; // + comment
947 var sig: packed array [0..3] of Char; off, lim: Int64;
948 begin
949 Result := False;
950 if s.Size >= maxedir then
951 begin
952 if s.Size < maxecdir then lim := s.Size else lim := maxecdir;
953 lim := lim - maxedir;
954 off := maxedir;
955 while (off <= lim) and (Result = False) do
956 begin
957 s.Seek(s.Size - off, TSeekOrigin.soBeginning);
958 s.ReadBuffer(sig[0], 4);
959 Result := sig = ZIP_SIGN_EOCD;
960 Inc(off);
961 end;
962 end;
963 end;
964
965 procedure TZIPEditor.ReadEOCD(s: TStream);
966 var sig: packed array [0..3] of Char;
967 var idisk, ndisk, nrec, total, comlen: UInt16;
968 var csize, cpos, i: UInt32;
969 var mypos: UInt64;
970 begin
971 FLastError := DFWAD_ERROR_FILENOTWAD;
972 FVersion := 0;
973 s.ReadBuffer(sig[0], 4);
974 if (sig = ZIP_SIGN_LFH) or (sig = ZIP_SIGN_EOCD) then
975 begin
976 if FindEOCD(s) then
977 begin
978 // End of Central Directory found
979 FLastError := DFWAD_ERROR_READWAD;
980 mypos := s.Position - 4;
981 idisk := LEtoN(s.ReadWord());
982 ndisk := LEtoN(s.ReadWord());
983 nrec := LEtoN(s.ReadWord());
984 total := LEtoN(s.ReadWord());
985 csize := LEtoN(s.ReadDWord());
986 cpos := LEtoN(s.ReadDWord());
987 comlen := LEtoN(s.ReadWord());
988 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
989 begin
990 e_WriteLog('==============================================', MSG_NOTIFY);
991 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Disk ID : ' + IntToStr(idisk), MSG_NOTIFY);
992 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Disk ID with CD : ' + IntToStr(ndisk), MSG_NOTIFY);
993 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Available CDR''s : ' + IntToStr(nrec), MSG_NOTIFY);
994 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Total CDR''s : ' + IntToStr(total), MSG_NOTIFY);
995 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': CD Length : ' + IntToStr(csize), MSG_NOTIFY);
996 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': CD Offset : $' + IntToHex(cpos, 8), MSG_NOTIFY);
997 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Comment Length : ' + IntToStr(comlen), MSG_NOTIFY);
998 end;
999 if (idisk <> $ffff) and (ndisk <> $ffff) and (nrec <> $ffff) and (total <> $ffff) and (csize <> $ffffffff) and (cpos <> $ffffffff) then
1000 begin
1001 if s.Position + comlen = s.Size then
1002 begin
1003 if (idisk = 0) and (ndisk = 0) and (nrec = total) then
1004 begin
1005 if (nrec * 46 <= csize) and (UInt64(cpos) + csize <= s.Size) then
1006 begin
1007 if total > 0 then
1008 begin
1009 i := 0;
1010 s.Seek(cpos, TSeekOrigin.soBeginning);
1011 while i < nrec do
1012 begin
1013 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1014 e_WriteLog('==============================================', MSG_NOTIFY);
1015 ReadCDR(s, i);
1016 Inc(i);
1017 end;
1018 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1019 e_WriteLog('==============================================', MSG_NOTIFY);
1020 end;
1021 end
1022 else
1023 raise Exception.Create('Central Directory too big (corrupted file?)');
1024 end
1025 else
1026 raise Exception.Create('Splitted archives not supported');
1027 end
1028 else
1029 raise Exception.Create('EOCD too big (corrupted file?)');
1030 end
1031 else
1032 raise Exception.Create('ZIP64 not supported');
1033 end
1034 else
1035 raise Exception.Create('EOCD not found (corrupted file?)');
1036 end
1037 else
1038 raise Exception.Create('Not DFZIP formated file');
1039 end;
1040
1041 function TZIPEditor.ReadFile2(FileName: String): Boolean;
1042 var s: TFileStream;
1043 begin
1044 FreeWAD();
1045 Result := False;
1046 try
1047 try
1048 s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
1049 try
1050 ReadEOCD(s);
1051 FStream := s;
1052 FLastError := DFWAD_NOERROR;
1053 Result := True;
1054 except
1055 s.Free();
1056 raise;
1057 end;
1058 except
1059 on e: Exception do
1060 begin
1061 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1062 e_WriteLog('ZIP: Failed to read ZIP from file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
1063 FreeWAD();
1064 end;
1065 end;
1066 except
1067 on e: EFOpenError do
1068 begin
1069 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1070 e_WriteLog('DFZIP: Failed to open file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
1071 if FileExists(FileName) then
1072 FLastError := DFWAD_ERROR_CANTOPENWAD
1073 else
1074 FLastError := DFWAD_ERROR_WADNOTFOUND;
1075 end;
1076 end;
1077 end;
1078
1079 function TZIPEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
1080 var s: TMemoryStream;
1081 begin
1082 FreeWAD();
1083 Result := False;
1084 try
1085 s := TMemoryStream.Create;
1086 try
1087 s.SetSize(Len);
1088 s.WriteBuffer(PByte(Data)[0], Len);
1089 s.Seek(0, soBeginning);
1090 ReadEOCD(s);
1091 FStream := s;
1092 FLastError := DFWAD_NOERROR;
1093 Result := True;
1094 except
1095 s.Free();
1096 raise;
1097 end;
1098 except
1099 on e: Exception do
1100 begin
1101 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1102 e_WriteLog('DFZIP: Failed to read ZIP from memory, reason: ' + e.Message, MSG_WARNING);
1103 FreeWAD();
1104 end;
1105 end;
1106 end;
1107
1108 procedure TZIPEditor.RemoveResource(Section, Resource: String);
1109 var p: PSection; i: Integer;
1110 begin
1111 Section := win2utf(Section);
1112 Resource := win2utf(Resource);
1113 p := FindSection(Section);
1114 i := FindResourceID(p, Resource);
1115 if i >= 0 then
1116 begin
1117 if p.list[i].stream <> nil then
1118 FreeAndNil(p.list[i].stream);
1119 for i := i + 1 to High(p.list) do
1120 begin
1121 p.list[i - 1] := p.list[i];
1122 end;
1123 SetLength(p.list, High(p.list));
1124 end;
1125 end;
1126
1127 function GetZIPVersion(const afname: AnsiString; flags, comp: UInt16): UInt8;
1128 var version: UInt8;
1129 begin
1130 version := 10; // Base version
1131 case comp of
1132 ZIP_COMP_STORE: version := 10;
1133 ZIP_COMP_SHRUNK: version := 10;
1134 ZIP_COMP_REDUCE1: version := 10;
1135 ZIP_COMP_REDUCE2: version := 10;
1136 ZIP_COMP_REDUCE3: version := 10;
1137 ZIP_COMP_REDUCE4: version := 10;
1138 ZIP_COMP_IMPLODE: version := 10;
1139 ZIP_COMP_TOKENIZED: version := 20;
1140 ZIP_COMP_DEFLATE: version := 20;
1141 ZIP_COMP_DEFLATE64: version := 21;
1142 ZIP_COMP_TERSE1: version := 25; // PKWARE DCL Implode
1143 ZIP_COMP_BZIP2: version := 46;
1144 ZIP_COMP_LZMA: version := 63;
1145 ZIP_COMP_CMPSC: version := 63;
1146 ZIP_COMP_TERSE2: version := 63;
1147 ZIP_COMP_LZ77: version := 63;
1148 ZIP_COMP_ZSTD1: version := 63;
1149 ZIP_COMP_ZSTD2: version := 63;
1150 ZIP_COMP_MP3: version := 63;
1151 ZIP_COMP_XZ: version := 63;
1152 ZIP_COMP_JPEG: version := 63;
1153 ZIP_COMP_WAVPACK: version := 63;
1154 ZIP_COMP_PPMD: version := 63;
1155 ZIP_COMP_AE: version := 63;
1156 end;
1157 if afname[Length(afname)] = '/' then
1158 version := Max(20, version); // Folder
1159 if flags and ZIP_UTF8_MASK <> 0 then
1160 version := Max(63, version); // UTF-8 name
1161 Result := version;
1162 end;
1163
1164 procedure TZIPEditor.WriteLFH(s: TStream; comp, mtime, crc, csize, usize: UInt32; const afname: AnsiString);
1165 var fname: PChar; version: UInt8; fnlen, flags: UInt16; mypos: UInt64;
1166 begin
1167 mypos := s.Position;
1168 fname := PChar(afname);
1169 fnlen := Length(fname);
1170 flags := 0;
1171 if IsASCII(afname) = False then
1172 flags := flags or ZIP_UTF8_MASK;
1173 version := GetZIPVersion(afname, flags, comp);
1174 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1175 begin
1176 e_WriteLog('==============================================', MSG_NOTIFY);
1177 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Min Version : ' + IntToStr(version), MSG_NOTIFY);
1178 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Min System : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1179 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Flags : $' + IntToHex(flags, 4), MSG_NOTIFY);
1180 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Compression : ' + IntToStr(comp), MSG_NOTIFY);
1181 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Modification Time : ' + DosToStr(mtime), MSG_NOTIFY);
1182 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': CRC-32 : $' + IntToHex(crc, 8), MSG_NOTIFY);
1183 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Compressed size : ' + IntToStr(csize), MSG_NOTIFY);
1184 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
1185 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Name Length : ' + IntToStr(fnlen), MSG_NOTIFY);
1186 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Extension Length : ' + IntToStr(0), MSG_NOTIFY);
1187 e_WriteLog('LFH @' + IntToHex(mypos, 8) + ': Name : "' + fname + '"', MSG_NOTIFY);
1188 end;
1189 s.WriteBuffer(ZIP_SIGN_LFH, 4); // LFH Signature
1190 s.WriteByte(version); // Min version
1191 s.WriteByte(ZIP_SYSTEM); // System
1192 WriteInt(s, UInt16(flags)); // Flags
1193 WriteInt(s, UInt16(comp)); // Compression method
1194 WriteInt(s, UInt32(mtime)); // Modification time/date
1195 WriteInt(s, UInt32(crc)); // CRC-32
1196 WriteInt(s, UInt32(csize)); // Compressed size
1197 WriteInt(s, UInt32(usize)); // Decompressed size
1198 WriteInt(s, UInt16(fnlen)); // Name field length
1199 WriteInt(s, UInt16(0)); // Extra field length
1200 s.WriteBuffer(fname[0], fnlen); // File Name
1201 end;
1202
1203 procedure TZIPEditor.WriteCDR(s: TStream; comp, mtime, crc, csize, usize, eattr, offset: UInt32; const afname: AnsiString; cdrid: Integer);
1204 var fname: PChar; version: UInt8; fnlen, flags: UInt16; mypos: UInt64;
1205 begin
1206 mypos := s.Position;
1207 fname := PChar(afname);
1208 fnlen := Length(fname);
1209 flags := 0;
1210 if IsASCII(afname) = False then
1211 flags := flags or ZIP_UTF8_MASK;
1212 version := GetZIPVersion(afname, flags, comp);
1213 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1214 begin
1215 e_WriteLog('==============================================', MSG_NOTIFY);
1216 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer Version : ' + IntToStr(ZIP_MAXVERSION), MSG_NOTIFY);
1217 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer System : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1218 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min Version : ' + IntToStr(version), MSG_NOTIFY);
1219 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min System : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1220 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Flags : $' + IntToHex(flags, 4), MSG_NOTIFY);
1221 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compression : ' + IntToStr(comp), MSG_NOTIFY);
1222 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Modification Time : ' + DosToStr(mtime), MSG_NOTIFY);
1223 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': CRC-32 : $' + IntToHex(crc, 8), MSG_NOTIFY);
1224 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compressed size : ' + IntToStr(csize), MSG_NOTIFY);
1225 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
1226 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name Length : ' + IntToStr(fnlen), MSG_NOTIFY);
1227 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Extension Length : ' + IntToStr(0), MSG_NOTIFY);
1228 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Comment Length : ' + IntToStr(0), MSG_NOTIFY);
1229 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Disk : ' + IntToStr(0), MSG_NOTIFY);
1230 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Internal Attrib : $' + IntToHex(0, 4), MSG_NOTIFY);
1231 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': External Attrib : $' + IntToHex(eattr, 8), MSG_NOTIFY);
1232 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': LFH Offset : $' + IntToHex(offset, 8), MSG_NOTIFY);
1233 e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name : "' + fname + '"', MSG_NOTIFY);
1234 end;
1235 s.WriteBuffer(ZIP_SIGN_CDR, 4); // CDR Signature
1236 s.WriteByte(ZIP_MAXVERSION); // Used version
1237 s.WriteByte(ZIP_SYSTEM); // Used system
1238 s.WriteByte(version); // Min version
1239 s.WriteByte(ZIP_SYSTEM); // Min system
1240 WriteInt(s, UInt16(flags)); // Flags
1241 WriteInt(s, UInt16(comp)); // Compression method
1242 WriteInt(s, UInt32(mtime)); // Modification time/date
1243 WriteInt(s, UInt32(crc)); // CRC-32
1244 WriteInt(s, UInt32(csize)); // Compressed size
1245 WriteInt(s, UInt32(usize)); // Decompressed size
1246 WriteInt(s, UInt16(fnlen)); // Name field length
1247 WriteInt(s, UInt16(0)); // Extra field length
1248 WriteInt(s, UInt16(0)); // Comment field length
1249 WriteInt(s, UInt16(0)); // Disk
1250 WriteInt(s, UInt16(0)); // Internal attributes
1251 WriteInt(s, UInt32(eattr)); // External attributes
1252 WriteInt(s, UInt32(offset)); // LFH offset
1253 s.WriteBuffer(fname[0], fnlen); // File Name
1254 end;
1255
1256 procedure TZIPEditor.SaveToStream(s: TStream);
1257 var i, j: Integer;
1258 var start, offset, loffset, size, zcrc, count: UInt32;
1259 var p: PResource;
1260 var afname: AnsiString;
1261 var mypos: UInt64;
1262 begin
1263 // Write LFH headers and data
1264 start := s.Position;
1265 zcrc := crc32(0, nil, 0);
1266 if FSection <> nil then
1267 begin
1268 for i := 0 to High(FSection) do
1269 begin
1270 if FSection[i].list <> nil then
1271 begin
1272 for j := 0 to High(FSection[i].list) do
1273 begin
1274 p := @FSection[i].list[j];
1275 afname := GetFileName(FSection[i].name, p.name);
1276 WriteLFH(s, p.comp, p.mtime, p.chksum, p.csize, p.usize, afname);
1277 if p.stream <> nil then
1278 begin
1279 Assert(p.stream.Size = p.csize);
1280 p.stream.SaveToStream(s);
1281 end
1282 else if FStream <> nil then
1283 begin
1284 FStream.Seek(p.pos, TSeekOrigin.soBeginning);
1285 s.CopyFrom(FStream, p.csize);
1286 end
1287 else
1288 begin
1289 raise Exception.Create('No data source available (somethig very wrong)');
1290 end;
1291 end;
1292 end
1293 else
1294 begin
1295 afname := GetFileName(FSection[i].name, '');
1296 WriteLFH(s, ZIP_COMP_STORE, FSection[i].mtime, zcrc, 0, 0, afname);
1297 end;
1298 end;
1299 end;
1300 // Write CDR headers
1301 count := 0;
1302 loffset := 0;
1303 offset := s.Position - start;
1304 if FSection <> nil then
1305 begin
1306 for i := 0 to High(FSection) do
1307 begin
1308 if FSection[i].list <> nil then
1309 begin
1310 for j := 0 to High(FSection[i].list) do
1311 begin
1312 p := @FSection[i].list[j];
1313 afname := GetFileName(FSection[i].name, p.name);
1314 WriteCDR(s, p.comp, p.mtime, p.chksum, p.csize, p.usize, $00, loffset, afname, i);
1315 loffset := loffset + 30 + Length(afname) + p.csize;
1316 Inc(count);
1317 end;
1318 end
1319 else
1320 begin
1321 afname := GetFileName(FSection[i].name, '');
1322 WriteCDR(s, ZIP_COMP_STORE, FSection[i].mtime, zcrc, 0, 0, $10, loffset, afname, i);
1323 loffset := loffset + 30 + Length(afname) + 0;
1324 Inc(count);
1325 end;
1326 end;
1327 end;
1328 Assert(loffset = offset);
1329 Assert(count < $ffff);
1330 size := s.Position - start - offset;
1331 // Write EOCD header
1332 mypos := s.Position;
1333 if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1334 begin
1335 e_WriteLog('==============================================', MSG_NOTIFY);
1336 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Disk ID : ' + IntToStr(0), MSG_NOTIFY);
1337 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Disk ID with CD : ' + IntToStr(0), MSG_NOTIFY);
1338 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Available CDR''s : ' + IntToStr(count), MSG_NOTIFY);
1339 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Total CDR''s : ' + IntToStr(count), MSG_NOTIFY);
1340 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': CD Length : ' + IntToStr(size), MSG_NOTIFY);
1341 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': CD Offset : $' + IntToHex(offset, 8), MSG_NOTIFY);
1342 e_WriteLog('EOCD @' + IntToHex(mypos, 8) + ': Comment Length : ' + IntToStr(0), MSG_NOTIFY);
1343 e_WriteLog('==============================================', MSG_NOTIFY);
1344 end;
1345 s.WriteBuffer(ZIP_SIGN_EOCD, 4); // EOCD Signature
1346 WriteInt(s, UInt16(0)); // Disk
1347 WriteInt(s, UInt16(0)); // Num of Disks
1348 WriteInt(s, UInt16(count)); // Num of CDRs
1349 WriteInt(s, UInt16(count)); // Total CDR entries
1350 WriteInt(s, UInt32(size)); // Central Directory size
1351 WriteInt(s, UInt32(offset)); // Central Directory offset
1352 WriteInt(s, UInt16(0)); // Comment field length
1353 end;
1354
1355 procedure TZIPEditor.SaveTo(FileName: String);
1356 var s: TFileStream;
1357 begin
1358 try
1359 s := TFileStream.Create(FileName, fmCreate);
1360 try
1361 SaveToStream(s);
1362 finally
1363 s.Free();
1364 end;
1365 except
1366 on e: Exception do
1367 begin
1368 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1369 e_WriteLog('ZIP: Failed to create file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
1370 raise e;
1371 end;
1372 end;
1373 end;
1374
1375 function TZIPEditor.GetLastError: Integer;
1376 begin
1377 Result := FLastError;
1378 end;
1379
1380 function TZIPEditor.GetLastErrorStr: String;
1381 begin
1382 case FLastError of
1383 DFWAD_NOERROR: Result := '';
1384 DFWAD_ERROR_WADNOTFOUND: Result := 'DFZIP file not found';
1385 DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFZIP file';
1386 DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
1387 DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFZIP';
1388 DFWAD_ERROR_WADNOTLOADED: Result := 'DFZIP file is not loaded';
1389 DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
1390 DFWAD_ERROR_READWAD: Result := 'Read DFZIP error';
1391 otherwise Result := IntToStr(FLastError);
1392 end;
1393 end;
1394
1395 function TZIPEditor.GetResourcesCount: Word;
1396 var i: Integer;
1397 begin
1398 Result := 0;
1399 if FSection <> nil then
1400 begin
1401 Result := Result + Length(FSection);
1402 for i := 0 to High(FSection) do
1403 if FSection[i].list <> nil then
1404 Result := Result + Length(FSection[i].list);
1405 end;
1406 end;
1407
1408 function TZIPEditor.GetVersion: Byte;
1409 begin
1410 Result := FVersion;
1411 end;
1412
1413 begin
1414 gWADEditorFactory.RegisterEditor('DFZIP', TZIPEditor);
1415 end.
[MIRROR] Doom2DF editor ported to FPC/Lazarus
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024