DEADSOFTWARE
GIT / REPO / FRED-BOY

Projects / d2df-editor.git / blob


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