DEADSOFTWARE

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