DEADSOFTWARE

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


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