1 {$INCLUDE ../shared/a_modes.inc}
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 // - Expects UTF-8 or CP1251 encoded names
10 // - ZIP64 is not supported
11 // - Encryption is not supported
12 // - Zero-length file names are not supported
13 // - CDR holds most actual data about file, LFH mostly ignored
14 // - Attributes and extra data are ignored and not preserved
15 // - Supports STORE and DEFLATE compression methods
19 uses Classes
, WADEDITOR
;
32 stream
: TMemoryStream
;
39 list
: array of TResource
;
42 PResource
= ^TResource
;
45 TZIPEditor
= class sealed(WADEDITOR
.TWADEditor
)
47 FSection
: array of TSection
;
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
;
57 function FindSectionID(name
: AnsiString
): Integer;
58 function FindSection(name
: AnsiString
): PSection
;
59 function InsertSection(name
: AnsiString
; mtime
: UInt32
; comment
: AnsiString
): PSection
;
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
;
67 procedure ReadLFH(s
: TStream
; fname
, xcomment
: AnsiString
; xcsize
, xusize
, xcomp
, xcrc
, xtime
, xflags
: UInt32
);
68 procedure ReadCDR(s
: TStream
; cdrid
: Integer);
69 function FindEOCD(s
: TStream
): Boolean;
70 procedure ReadEOCD(s
: TStream
);
72 procedure WriteLFH(s
: TStream
; flags
, comp
, mtime
, crc
, csize
, usize
: UInt32
; const name
: AnsiString
);
73 procedure WriteCDR(s
: TStream
; flags
, comp
, mtime
, crc
, csize
, usize
, eattr
, offset
: UInt32
; const name
, com
: AnsiString
; cdrid
: Integer);
74 procedure SaveToStream(s
: TStream
);
78 destructor Destroy(); override;
79 procedure FreeWAD(); override;
80 function ReadFile2(FileName
: string): Boolean; override;
81 function ReadMemory(Data
: Pointer; Len
: LongWord
): Boolean; override;
82 procedure CreateImage(); override;
83 function AddResource(Data
: Pointer; Len
: LongWord
; Name
, Section
: String): Boolean; override; overload
;
84 function AddResource(FileName
, Name
, Section
: String): Boolean; override; overload
;
85 function AddAlias(Res
, Alias
: String): Boolean; override;
86 procedure AddSection(Name
: String); override;
87 procedure RemoveResource(Section
, Resource
: String); override;
88 procedure SaveTo(FileName
: String); override;
89 function HaveResource(Section
, Resource
: String): Boolean; override;
90 function HaveSection(Section
: string): Boolean; override;
91 function GetResource(Section
, Resource
: String; var pData
: Pointer; var Len
: Integer): Boolean; override;
92 function GetSectionList(): SArray
; override;
93 function GetResourcesList(Section
: String): SArray
; override;
95 function GetLastError
: Integer; override;
96 function GetLastErrorStr
: String; override;
97 function GetResourcesCount
: Word; override;
98 function GetVersion
: Byte; override;
103 uses SysUtils
, StrUtils
, DateUtils
, Math
, utils
, zstream
, crc
, e_log
;
106 ZIP_SIGN_CDR
= 'PK'#1#2;
107 ZIP_SIGN_LFH
= 'PK'#3#4;
108 ZIP_SIGN_EOCD
= 'PK'#5#6;
113 ZIP_COMP_REDUCE1
= 2;
114 ZIP_COMP_REDUCE2
= 3;
115 ZIP_COMP_REDUCE3
= 4;
116 ZIP_COMP_REDUCE4
= 5;
117 ZIP_COMP_IMPLODE
= 6;
118 ZIP_COMP_TOKENIZED
= 7;
119 ZIP_COMP_DEFLATE
= 8;
120 ZIP_COMP_DEFLATE64
= 9;
121 ZIP_COMP_TERSE1
= 10;
125 ZIP_COMP_TERSE2
= 18;
132 ZIP_COMP_WAVPACK
= 97;
137 ZIP_SYSTEM
= 0; // DOS / FAT
138 ZIP_MAXVERSION
= 63; // Max supported version
141 ZIP_ENCRYPTION_MASK
= (1 << 0) or (1 << 6) or (1 << 13);
142 ZIP_COMP_MASK
= (1 << 1) or (1 << 2) or (1 << 4) or (1 << 12);
143 ZIP_DATA_MASK
= (1 << 3);
144 ZIP_PATCH_MASK
= (1 << 5);
145 ZIP_UTF8_MASK
= (1 << 11);
146 ZIP_STREAM_MASK
= (1 << 14);
148 function IsASCII(const s
: AnsiString
): Boolean;
151 for i
:= 1 to Length(s
) do
162 function IsUTF8(const s
: AnsiString
): Boolean;
163 var i
, j
, len
: Integer;
166 i
:= 1; len
:= Length(s
);
171 $80..$BF: exit
; // invalid encoding
175 otherwise exit
; // invalid encoding
180 if i
> len
then exit
; // invlid length
183 else exit
; // invalid encoding
192 function DosToStr(dostime
: UInt32
): AnsiString
;
195 DateTimeToString(Result
, 'yyyy/mm/dd hh:nn:ss', DosDateTimeToDateTime(dostime
));
196 except on e
: EConvertError
do
197 Result
:= 'INVALID ($' + IntToHex(dostime
, 8) + ')';
201 procedure ToSectionFile(fname
: AnsiString
; out section
, name
: AnsiString
); inline;
204 i
:= LastDelimiter('/', fname
);
205 section
:= Copy(fname
, 1, i
- 1);
206 name
:= Copy(fname
, i
+ 1)
209 function GetFileName(const Section
, Name
: AnsiString
): AnsiString
; inline;
214 Result
:= Section
+ '/' + Name
;
217 function PrepString(const s
: AnsiString
; caseSensitive
, extSensitive
: Boolean): AnsiString
; inline;
221 if caseSensitive
= False then
223 Result
:= UpperCase(Result
);
225 if extSensitive
= False then
227 i
:= Pos('.', Result
); // fix dotfiles
229 SetLength(Result
, i
- 1);
233 function FindResourceIDRAW(p
: PSection
; name
: AnsiString
; caseSensitive
, extSensitive
: Boolean): Integer;
234 var i
: Integer; pname
: AnsiString
;
238 pname
:= PrepString(name
, caseSensitive
, extSensitive
);
239 for i
:= 0 to High(p
.list
) do
241 if PrepString(p
.list
[i
].name
, caseSensitive
, extSensitive
) = pname
then
251 function FindResourceID(p
: PSection
; name
: AnsiString
): Integer;
254 i
:= FindResourceIDRAW(p
, name
, True, True); // CaSeNaMe.Ext
257 i
:= FindResourceIDRAW(p
, name
, False, True); // CASENAME.EXT
260 i
:= FindResourceIDRAW(p
, name
, True, False); // CaSeNaMe
263 i
:= FindResourceIDRAW(p
, name
, False, False); // CASENAME
270 function FindResource(p
: PSection
; name
: AnsiString
): PResource
;
273 i
:= FindResourceID(p
, name
);
282 function TZIPEditor
.FindSectionIDRAW(name
: AnsiString
; caseSensitive
: Boolean): Integer;
283 var i
: Integer; pname
: AnsiString
;
285 if FSection
<> nil then
287 pname
:= PrepString(name
, caseSensitive
, True);
288 for i
:= 0 to High(FSection
) do
290 if PrepString(FSection
[i
].name
, caseSensitive
, True) = pname
then
300 function TZIPEditor
.FindSectionRAW(name
: AnsiString
; caseSensitive
: Boolean): PSection
;
303 i
:= FindSectionIDRAW(name
, caseSensitive
);
305 Result
:= @FSection
[i
]
310 function TZIPEditor
.InsertSectionRAW(name
: AnsiString
; mtime
: UInt32
; comment
: AnsiString
): PSection
;
313 if FSection
= nil then i
:= 0 else i
:= Length(FSection
);
314 SetLength(FSection
, i
+ 1);
315 FSection
[i
] := Default(TSection
);
316 FSection
[i
].name
:= name
;
317 FSection
[i
].mtime
:= mtime
;
318 FSection
[i
].comment
:= comment
;
319 Result
:= @FSection
[i
];
324 function TZIPEditor
.FindSectionID(name
: AnsiString
): Integer;
325 var fixName
: AnsiString
;
327 fixName
:= StringReplace(name
, '\', '/', [rfReplaceAll
], TStringReplaceAlgorithm
.sraManySmall
);
328 Result
:= FindSectionIDRAW(fixName
, True); // CaSeNaMe
330 Result
:= FindSectionIDRAW(fixName
, False); // CASENAME
333 function TZIPEditor
.FindSection(name
: AnsiString
): PSection
;
334 var fixName
: AnsiString
;
336 fixName
:= StringReplace(name
, '\', '/', [rfReplaceAll
], TStringReplaceAlgorithm
.sraManySmall
);
337 Result
:= FindSectionRAW(fixName
, True); // CaSeNaMe
339 Result
:= FindSectionRAW(fixName
, False); // CASENAME
342 function TZIPEditor
.InsertSection(name
: AnsiString
; mtime
: UInt32
; comment
: AnsiString
): PSection
;
344 Result
:= FindSection(name
);
346 Result
:= InsertSectionRAW(name
, mtime
, comment
);
351 function TZIPEditor
.InsertFileInfo(const section
, name
: AnsiString
; pos
, csize
, usize
, comp
, crc
, mtime
, flags
: UInt32
; comment
: AnsiString
): PResource
;
352 var p
: PSection
; i
: Integer;
354 p
:= FindSectionRAW(section
, True);
356 p
:= InsertSectionRAW(section
, mtime
, '');
357 if p
.list
= nil then i
:= 0 else i
:= Length(p
.list
);
358 SetLength(p
.list
, i
+ 1);
359 p
.list
[i
] := Default(TResource
);
360 p
.list
[i
].name
:= name
;
361 p
.list
[i
].pos
:= pos
;
362 p
.list
[i
].csize
:= csize
;
363 p
.list
[i
].usize
:= usize
;
364 p
.list
[i
].comp
:= comp
;
365 p
.list
[i
].chksum
:= crc
;
366 p
.list
[i
].mtime
:= mtime
;
367 p
.list
[i
].flags
:= flags
;
368 p
.list
[i
].comment
:= comment
;
369 p
.list
[i
].stream
:= nil;
370 Result
:= @p
.list
[i
];
375 function TZIPEditor
.AddAlias(Res
, Alias
: String): Boolean;
377 // Hard-links not supported in ZIP
378 // However, they never created by editor
382 function TZIPEditor
.AddResource(Data
: Pointer; Len
: LongWord
; Name
, Section
: String): Boolean;
383 const compress
: Boolean = True;
384 const level
: TCompressionLevel
= TCompressionLevel
.clMax
;
385 var s
: TMemoryStream
; cs
: TCompressionStream
; p
: PResource
;
386 var comp
, crc
: UInt32
;
388 Name
:= win2utf(Name
);
389 Section
:= win2utf(Section
);
393 s
:= TMemoryStream
.Create();
395 if compress
and (Len
> 0) then
397 cs
:= TCompressionStream
.Create(level
, s
, True);
399 cs
.WriteBuffer(PByte(Data
)[0], Len
);
401 comp
:= ZIP_COMP_DEFLATE
;
406 if (Len
= 0) or (compress
= False) or (s
.Size
>= Len
) then
408 s
.Seek(0, TSeekOrigin
.soBeginning
);
410 s
.WriteBuffer(PByte(Data
)[0], Len
);
411 comp
:= ZIP_COMP_STORE
;
412 Assert(s
.Size
= Len
);
414 crc
:= crc32(0, nil, 0);
415 crc
:= crc32(crc
, data
, len
);
416 p
:= InsertFileInfo(Section
, Name
, $ffffffff, s
.Size
, Len
, comp
, crc
, DateTimeToDosDateTime(Now()), 0, '');
426 function TZIPEditor
.AddResource(FileName
, Name
, Section
: String): Boolean;
427 var s
: TFileStream
; ptr
: PByte
;
430 FLastError
:= DFWAD_ERROR_READWAD
;
432 s
:= TFileStream
.Create(FileName
, fmOpenRead
or fmShareDenyWrite
);
436 s
.ReadBuffer(ptr
[0], s
.Size
);
437 Result
:= AddResource(ptr
, s
.Size
, Name
, Section
);
438 if Result
= True then FLastError
:= DFWAD_NOERROR
;
448 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
449 e_WriteLog('DFZIP: AddResource: failed to open file ' + FileName
, MSG_NOTIFY
);
450 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
455 constructor TZIPEditor
.Create();
460 FLastError
:= DFWAD_NOERROR
;
464 destructor TZIPEditor
.Destroy();
470 procedure TZIPEditor
.Clear();
473 if FSection
<> nil then
475 for i
:= 0 to High(FSection
) do
477 if FSection
[i
].list
<> nil then
479 for j
:= 0 to High(FSection
[i
].list
) do
481 if FSection
[i
].list
[j
].stream
<> nil then
483 FreeAndNil(FSection
[i
].list
[j
].stream
);
486 SetLength(FSection
[i
].list
, 0);
489 SetLength(FSection
, 0);
491 if FStream
<> nil then
498 procedure TZIPEditor
.FreeWAD();
501 FLastError
:= DFWAD_NOERROR
;
505 function TZIPEditor
.Preload(p
: PResource
): Boolean;
506 var s
: TMemoryStream
;
511 Result
:= p
.stream
<> nil;
512 if (p
.stream
= nil) and (FStream
<> nil) then
514 s
:= TMemoryStream
.Create();
518 FStream
.Seek(p
.pos
, TSeekOrigin
.soBeginning
);
519 s
.CopyFrom(FStream
, p
.csize
);
521 Assert(s
.Size
= p
.csize
); // wtf, random size if copied zero bytes!
531 procedure TZIPEditor
.CreateImage();
534 if FStream
= nil then
536 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
537 e_WriteLog('DFZIP: CreateImage: File not assigned', MSG_NOTIFY
);
538 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
540 else if FStream
is TMemoryStream
then
542 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
543 e_WriteLog('DFZIP: CreateImage: Memory stream', MSG_NOTIFY
);
544 FLastError
:= DFWAD_NOERROR
;
548 if FSection
<> nil then
550 for i
:= 0 to High(FSection
) do
552 if FSection
[i
].list
<> nil then
554 for j
:= 0 to High(FSection
[i
].list
) do
556 if Preload(@FSection
[i
].list
[j
]) = False then
558 if gWADEditorLogLevel
>= DFWAD_LOG_WARN
then
559 e_WriteLog('DFZIP: CreateImage: failed to preload resource [' + FSection
[i
].name
+ '][' + FSection
[i
].list
[j
].name
+ ']', MSG_WARNING
);
560 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
568 FLastError
:= DFWAD_NOERROR
;
572 procedure TZIPEditor
.AddSection(Name
: String);
574 Name
:= win2utf(Name
);
575 if InsertSection(Name
, DateTimeToDosDateTime(Now()), '') = nil then
576 raise Exception
.Create('DFZIP: AddSection[' + Name
+ ']: failed to insert');
579 function TZIPEditor
.HaveResource(Section
, Resource
: String): Boolean;
581 Section
:= win2utf(Section
);
582 Resource
:= win2utf(Resource
);
583 Result
:= FindResource(FindSection(Section
), Resource
) <> nil;
586 function TZIPEditor
.HaveSection(Section
: String): Boolean;
588 Section
:= win2utf(Section
);
589 Result
:= FindSection(Section
) <> nil;
592 function TZIPEditor
.GetSourceStream(p
: PResource
): TStream
;
596 if p
.stream
<> nil then
599 src
.Seek(0, TSeekOrigin
.soBeginning
);
601 else if FStream
<> nil then
604 src
.Seek(p
.pos
, TSeekOrigin
.soBeginning
);
609 function TZIPEditor
.GetResource(Section
, Resource
: String; var pData
: Pointer; var Len
: Integer): Boolean;
610 var p
: PResource
; ptr
: PByte
; src
: TStream
; tmp
: TDecompressionStream
; crc
: UInt32
;
612 Section
:= win2utf(Section
);
613 Resource
:= win2utf(Resource
);
614 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
618 p
:= FindResource(FindSection(Section
), Resource
);
621 src
:= GetSourceStream(p
);
627 Assert(p
.csize
= p
.usize
);
628 GetMem(ptr
, p
.usize
);
631 src
.ReadBuffer(ptr
[0], p
.usize
);
637 except on e
: EReadError
do
638 if gWADEditorLogLevel
>= DFWAD_LOG_WARN
then
639 e_WriteLog('DFZIP: Failed to read STOREd data, reason: ' + e
.Message, MSG_WARNING
);
644 tmp
:= TDecompressionStream
.Create(src
, True);
646 GetMem(ptr
, p
.usize
);
648 tmp
.ReadBuffer(ptr
[0], p
.usize
);
658 on e
: EStreamError
do
660 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
661 e_WriteLog('DFZIP: Failed to decompress DEFLATEd data, reason: ' + e
.Message, MSG_WARNING
);
666 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
667 e_WriteLog('DFZIP: Unsupported compression method: ' + IntToStr(p
.comp
), MSG_WARNING
);
672 if gWADEditorLogLevel
>= DFWAD_LOG_WARN
then
673 e_WriteLog('DFZIP: No available source for file data', MSG_WARNING
);
674 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
676 if Result
= True then
678 crc
:= crc32(0, nil, 0);
679 crc
:= crc32(crc
, ptr
, p
.usize
);
680 Result
:= crc
= p
.chksum
;
681 if Result
= True then
685 FLastError
:= DFWAD_NOERROR
;
689 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
690 e_WriteLog('DFZIP: File integrity check failed: expected CRC32 $' + IntToHex(p
.chksum
, 8) + ', calculated CRC32 $' + IntToHex(crc
, 8), MSG_WARNING
);
697 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
698 e_WriteLog('DFZIP: Resource not found', MSG_NOTIFY
);
699 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
703 function TZIPEditor
.GetResourcesList(Section
: String): SArray
;
704 var p
: PSection
; i
: Integer;
706 Section
:= win2utf(Section
);
708 p
:= FindSection(Section
);
709 if (p
<> nil) and (p
.list
<> nil) then
711 SetLength(Result
, Length(p
.list
));
712 for i
:= 0 to High(p
.list
) do
714 Result
[i
] := utf2win(p
.list
[i
].name
);
719 function TZIPEditor
.GetSectionList(): SArray
;
723 if FSection
<> nil then
725 SetLength(Result
, Length(FSection
));
726 for i
:= 0 to High(FSection
) do
728 Result
[i
] := utf2win(FSection
[i
].name
);
733 procedure TZIPEditor
.ReadLFH(s
: TStream
; fname
, xcomment
: AnsiString
; xcsize
, xusize
, xcomp
, xcrc
, xtime
, xflags
: UInt32
);
734 var sig
: packed array [0..3] of Char;
735 var va
, vb
, flags
, comp
: UInt16
;
736 var mtime
, crc
, csize
, usize
: UInt32
;
737 var fnlen
, extlen
: UInt16
;
738 var mypos
, datapos
: UInt64
;
739 var section
, name
: AnsiString
;
743 if mypos
+ 30 <= s
.Size
then
745 s
.ReadBuffer(sig
[0], 4);
746 if sig
= ZIP_SIGN_LFH
then
748 va
:= s
.ReadByte(); // Min Version
749 vb
:= s
.ReadByte(); // Min System
750 flags
:= LEtoN(s
.ReadWord());
751 comp
:= LEtoN(s
.ReadWord());
752 mtime
:= LEtoN(s
.ReadDWord());
753 crc
:= LEtoN(s
.ReadDWord());
754 csize
:= LEtoN(s
.ReadDWord());
755 usize
:= LEtoN(s
.ReadDWord());
756 fnlen
:= LEtoN(s
.ReadWord());
757 extlen
:= LEtoN(s
.ReadWord());
758 datapos
:= s
.Position
+ fnlen
+ extlen
;
759 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
761 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Min Version : ' + IntToStr(va
), MSG_NOTIFY
);
762 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Min System : ' + IntToStr(vb
), MSG_NOTIFY
);
763 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Flags : $' + IntToHex(flags
, 4), MSG_NOTIFY
);
764 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Compression : ' + IntToStr(comp
), MSG_NOTIFY
);
765 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Modification Time : ' + DosToStr(mtime
), MSG_NOTIFY
);
766 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': CRC-32 : $' + IntToHex(crc
, 8), MSG_NOTIFY
);
767 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Compressed size : ' + IntToStr(csize
), MSG_NOTIFY
);
768 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Decompressed size : ' + IntToStr(usize
), MSG_NOTIFY
);
769 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Name Length : ' + IntToStr(fnlen
), MSG_NOTIFY
);
770 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Extension Length : ' + IntToStr(extlen
), MSG_NOTIFY
);
771 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': <DATA OFFSET> : $' + IntToHex(datapos
, 8), MSG_NOTIFY
);
773 if (va
>= 10) and (va
<= ZIP_MAXVERSION
) then
775 if datapos
+ xcsize
<= s
.Size
then
777 ToSectionFile(fname
, section
, name
);
780 p
:= FindSectionRAW(section
, True);
782 p
:= InsertSectionRAW(section
, xtime
, xcomment
);
786 p
:= InsertFileInfo(section
, name
, datapos
, xcsize
, xusize
, xcomp
, xcrc
, xtime
, xflags
and ZIP_COMP_MASK
, xcomment
);
789 raise Exception
.Create('Failed to register resource [' + fname
+ ']');
792 raise Exception
.Create('Invalid LFH size (corrupted file?)');
796 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
797 raise Exception
.Create('Unsupported CDR version ' + IntToStr(va
) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION
) + ']');
801 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?)');
804 raise Exception
.Create('Invalid LFH size (corrupted file?)');
807 procedure TZIPEditor
.ReadCDR(s
: TStream
; cdrid
: Integer);
808 var sig
: packed array [0..3] of Char;
809 var vva
, vvb
, va
, vb
, flags
, comp
: UInt16
;
810 var mtime
, crc
, csize
, usize
: UInt32
;
811 var fnlen
, extlen
, comlen
, disk
, iattr
: UInt16
;
812 var eattr
, offset
: UInt32
;
813 var mypos
, next
: UInt64
;
815 var name
, comment
: AnsiString
;
816 var cvtbug
, utf8
: Boolean;
819 s
.ReadBuffer(sig
[0], 4);
820 if sig
= ZIP_SIGN_CDR
then
822 // Valid Central Directory Signature
823 vva
:= s
.ReadByte(); // Writer Version
824 vvb
:= s
.ReadByte(); // Writer System
825 va
:= s
.ReadByte(); // Min Version
826 vb
:= s
.ReadByte(); // Min System
827 flags
:= LEtoN(s
.ReadWord());
828 comp
:= LEtoN(s
.ReadWord());
829 mtime
:= LEtoN(s
.ReadDWord());
830 crc
:= LEtoN(s
.ReadDWord());
831 csize
:= LEtoN(s
.ReadDWord());
832 usize
:= LEtoN(s
.ReadDWord());
833 fnlen
:= LEtoN(s
.ReadWord());
834 extlen
:= LEtoN(s
.ReadWord());
835 comlen
:= LEtoN(s
.ReadWord());
836 disk
:= LEtoN(s
.ReadWord());
837 iattr
:= LEtoN(s
.ReadWord());
838 eattr
:= LEtoN(s
.ReadDWord());
839 offset
:= LEtoN(s
.ReadDWord());
840 next
:= s
.Position
+ fnlen
+ extlen
+ comlen
;
842 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
844 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Writer Version : ' + IntToStr(vva
), MSG_NOTIFY
);
845 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Writer System : ' + IntToStr(vvb
), MSG_NOTIFY
);
846 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Min Version : ' + IntToStr(va
), MSG_NOTIFY
);
847 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Min System : ' + IntToStr(vb
), MSG_NOTIFY
);
848 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Flags : $' + IntToHex(flags
, 4), MSG_NOTIFY
);
849 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Compression : ' + IntToStr(comp
), MSG_NOTIFY
);
850 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Modification Time : ' + DosToStr(mtime
), MSG_NOTIFY
);
851 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': CRC-32 : $' + IntToHex(crc
, 8), MSG_NOTIFY
);
852 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Compressed size : ' + IntToStr(csize
), MSG_NOTIFY
);
853 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Decompressed size : ' + IntToStr(usize
), MSG_NOTIFY
);
854 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Name Length : ' + IntToStr(fnlen
), MSG_NOTIFY
);
855 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Extension Length : ' + IntToStr(extlen
), MSG_NOTIFY
);
856 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Comment Length : ' + IntToStr(comlen
), MSG_NOTIFY
);
857 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Disk : ' + IntToStr(disk
), MSG_NOTIFY
);
858 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Internal Attrib : $' + IntToHex(iattr
, 4), MSG_NOTIFY
);
859 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': External Attrib : $' + IntToHex(eattr
, 8), MSG_NOTIFY
);
860 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': LFH Offset : $' + IntToHex(offset
, 8), MSG_NOTIFY
);
863 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
865 // HACK: Editor and wadcvt for long time sets incorrent flag for UTF-8
866 flags
:= ZIP_UTF8_MASK
;
869 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
870 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': WADCVT BUG : ' + BoolToStr(cvtbug
, True), MSG_NOTIFY
);
871 if (va
>= 10) and (va
<= ZIP_MAXVERSION
) then
873 if (flags
and ZIP_ENCRYPTION_MASK
) = 0 then
875 if (flags
and ZIP_PATCH_MASK
) = 0 then
877 if (csize
<> $ffffffff) and (usize
<> $ffffffff) and (disk
<> $ffff) and (offset
<> $ffffffff) then
881 if (next
<= s
.Size
) and (fnlen
> 0) then
885 if csize
<> usize
then
886 raise Exception
.Create('Compressed size ' + IntToStr(csize
) + ' != Decompressed size ' + IntToStr(usize
) + 'for STORE method (corrupted file?)');
910 raise Exception
.Create('Encrypted archives are not supported');
912 raise Exception
.Create('Unknown compression method ' + IntToStr(comp
));
916 GetMem(tmp
, UInt32(fnlen
) + 1);
918 s
.ReadBuffer(tmp
[0], fnlen
);
924 // Skip ZIP extensions
925 s
.Seek(extlen
, TSeekOrigin
.soCurrent
);
930 GetMem(tmp
, UInt32(comlen
) + 1);
932 s
.ReadBuffer(tmp
[0], comlen
);
941 if (utf8
= False) or (flags
and ZIP_UTF8_MASK
= 0) and (IsUTF8(name
) = False) then
943 name
:= win2utf(name
);
946 if (utf8
= False) or (flags
and ZIP_UTF8_MASK
= 0) and (IsUTF8(comment
) = False) then
948 comment
:= win2utf(comment
);
951 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
953 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': UTF-8 Compatible : ' + BoolToStr(utf8
, True), MSG_NOTIFY
);
954 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Name : "' + name
+ '"', MSG_NOTIFY
);
955 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Comment : "' + comment
+ '"', MSG_NOTIFY
);
957 s
.Seek(offset
, TSeekOrigin
.soBeginning
);
958 ReadLFH(s
, name
, comment
, csize
, usize
, comp
, crc
, mtime
, flags
);
959 s
.Seek(next
, TSeekOrigin
.soBeginning
);
962 raise Exception
.Create('Empty files names are not supported');
965 raise Exception
.Create('Split archives are not supported');
969 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
970 raise Exception
.Create('ZIP64 archives are not supported');
975 FLastError
:= DFWAD_ERROR_READWAD
;
976 raise Exception
.Create('Patch archives are not supported');
981 FLastError
:= DFWAD_ERROR_READWAD
;
982 raise Exception
.Create('Encrypted archives are not supported');
987 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
988 raise Exception
.Create('Unsupported CDR version ' + IntToStr(va
) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION
) + ']');
992 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?)');
995 function TZIPEditor
.FindEOCD(s
: TStream
): Boolean;
996 const maxedir
= 20; // end of central directory entry
997 const maxecdir
= maxedir
+ 65536; // + comment
998 var sig
: packed array [0..3] of Char; off
, lim
: Int64;
1001 if s
.Size
>= maxedir
then
1003 if s
.Size
< maxecdir
then lim
:= s
.Size
else lim
:= maxecdir
;
1004 lim
:= lim
- maxedir
;
1006 while (off
<= lim
) and (Result
= False) do
1008 s
.Seek(s
.Size
- off
, TSeekOrigin
.soBeginning
);
1009 s
.ReadBuffer(sig
[0], 4);
1010 Result
:= sig
= ZIP_SIGN_EOCD
;
1016 procedure TZIPEditor
.ReadEOCD(s
: TStream
);
1017 var sig
: packed array [0..3] of Char;
1018 var idisk
, ndisk
, nrec
, total
, comlen
: UInt16
;
1019 var csize
, cpos
, i
: UInt32
;
1024 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
1026 s
.ReadBuffer(sig
[0], 4);
1027 if (sig
= ZIP_SIGN_LFH
) or (sig
= ZIP_SIGN_EOCD
) then
1031 // End of Central Directory found
1032 FLastError
:= DFWAD_ERROR_READWAD
;
1033 mypos
:= s
.Position
- 4;
1034 idisk
:= LEtoN(s
.ReadWord());
1035 ndisk
:= LEtoN(s
.ReadWord());
1036 nrec
:= LEtoN(s
.ReadWord());
1037 total
:= LEtoN(s
.ReadWord());
1038 csize
:= LEtoN(s
.ReadDWord());
1039 cpos
:= LEtoN(s
.ReadDWord());
1040 comlen
:= LEtoN(s
.ReadWord());
1041 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1043 e_WriteLog('==============================================', MSG_NOTIFY
);
1044 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Disk ID : ' + IntToStr(idisk
), MSG_NOTIFY
);
1045 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Disk ID with CD : ' + IntToStr(ndisk
), MSG_NOTIFY
);
1046 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Available CDR''s : ' + IntToStr(nrec
), MSG_NOTIFY
);
1047 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Total CDR''s : ' + IntToStr(total
), MSG_NOTIFY
);
1048 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': CD Length : ' + IntToStr(csize
), MSG_NOTIFY
);
1049 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': CD Offset : $' + IntToHex(cpos
, 8), MSG_NOTIFY
);
1050 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Comment Length : ' + IntToStr(comlen
), MSG_NOTIFY
);
1052 if (idisk
<> $ffff) and (ndisk
<> $ffff) and (nrec
<> $ffff) and (total
<> $ffff) and (csize
<> $ffffffff) and (cpos
<> $ffffffff) then
1054 if s
.Position
+ comlen
= s
.Size
then
1056 if (idisk
= 0) and (ndisk
= 0) and (nrec
= total
) then
1058 if (nrec
* 46 <= csize
) and (UInt64(cpos
) + csize
<= s
.Size
) then
1065 GetMem(tmp
, UInt32(comlen
) + 1);
1067 s
.ReadBuffer(tmp
[0], comlen
);
1070 if IsUTF8(FComment
) = False then
1072 FComment
:= win2utf(FComment
);
1079 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1081 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': UTF-8 Compatible : ' + BoolToStr(utf8
, True), MSG_NOTIFY
);
1082 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Comment : "' + FComment
+ '"', MSG_NOTIFY
);
1085 s
.Seek(cpos
, TSeekOrigin
.soBeginning
);
1088 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1089 e_WriteLog('==============================================', MSG_NOTIFY
);
1093 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1094 e_WriteLog('==============================================', MSG_NOTIFY
);
1098 raise Exception
.Create('Central Directory too big (corrupted file?)');
1101 raise Exception
.Create('Splitted archives not supported');
1104 raise Exception
.Create('EOCD too big (corrupted file?)');
1107 raise Exception
.Create('ZIP64 not supported');
1110 raise Exception
.Create('EOCD not found (corrupted file?)');
1113 raise Exception
.Create('Not DFZIP formatted file');
1116 function TZIPEditor
.ReadFile2(FileName
: String): Boolean;
1123 s
:= TFileStream
.Create(FileName
, fmOpenRead
or fmShareDenyWrite
);
1127 FLastError
:= DFWAD_NOERROR
;
1136 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
1137 e_WriteLog('ZIP: Failed to read ZIP from file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
1142 on e
: EFOpenError
do
1144 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
1145 e_WriteLog('DFZIP: Failed to open file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
1146 if FileExists(FileName
) then
1147 FLastError
:= DFWAD_ERROR_CANTOPENWAD
1149 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
1154 function TZIPEditor
.ReadMemory(Data
: Pointer; Len
: LongWord
): Boolean;
1155 var s
: TMemoryStream
;
1160 s
:= TMemoryStream
.Create
;
1163 s
.WriteBuffer(PByte(Data
)[0], Len
);
1164 s
.Seek(0, soBeginning
);
1167 FLastError
:= DFWAD_NOERROR
;
1176 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
1177 e_WriteLog('DFZIP: Failed to read ZIP from memory, reason: ' + e
.Message, MSG_WARNING
);
1183 procedure TZIPEditor
.RemoveResource(Section
, Resource
: String);
1184 var p
: PSection
; i
: Integer;
1186 Section
:= win2utf(Section
);
1187 Resource
:= win2utf(Resource
);
1188 p
:= FindSection(Section
);
1189 i
:= FindResourceID(p
, Resource
);
1192 if p
.list
[i
].stream
<> nil then
1193 FreeAndNil(p
.list
[i
].stream
);
1194 for i
:= i
+ 1 to High(p
.list
) do
1196 p
.list
[i
- 1] := p
.list
[i
];
1198 SetLength(p
.list
, High(p
.list
));
1202 function GetZIPVersion(const afname
: AnsiString
; flags
, comp
: UInt16
): UInt8
;
1205 version
:= 10; // Base version
1207 ZIP_COMP_STORE
: version
:= 10;
1208 ZIP_COMP_SHRUNK
: version
:= 10;
1209 ZIP_COMP_REDUCE1
: version
:= 10;
1210 ZIP_COMP_REDUCE2
: version
:= 10;
1211 ZIP_COMP_REDUCE3
: version
:= 10;
1212 ZIP_COMP_REDUCE4
: version
:= 10;
1213 ZIP_COMP_IMPLODE
: version
:= 10;
1214 ZIP_COMP_TOKENIZED
: version
:= 20;
1215 ZIP_COMP_DEFLATE
: version
:= 20;
1216 ZIP_COMP_DEFLATE64
: version
:= 21;
1217 ZIP_COMP_TERSE1
: version
:= 25; // PKWARE DCL Implode
1218 ZIP_COMP_BZIP2
: version
:= 46;
1219 ZIP_COMP_LZMA
: version
:= 63;
1220 ZIP_COMP_CMPSC
: version
:= 63;
1221 ZIP_COMP_TERSE2
: version
:= 63;
1222 ZIP_COMP_LZ77
: version
:= 63;
1223 ZIP_COMP_ZSTD1
: version
:= 63;
1224 ZIP_COMP_ZSTD2
: version
:= 63;
1225 ZIP_COMP_MP3
: version
:= 63;
1226 ZIP_COMP_XZ
: version
:= 63;
1227 ZIP_COMP_JPEG
: version
:= 63;
1228 ZIP_COMP_WAVPACK
: version
:= 63;
1229 ZIP_COMP_PPMD
: version
:= 63;
1230 ZIP_COMP_AE
: version
:= 63;
1232 if afname
[Length(afname
)] = '/' then
1233 version
:= Max(20, version
); // Folder
1234 if flags
and ZIP_UTF8_MASK
<> 0 then
1235 version
:= Max(63, version
); // UTF-8 name
1239 procedure TZIPEditor
.WriteLFH(s
: TStream
; flags
, comp
, mtime
, crc
, csize
, usize
: UInt32
; const name
: AnsiString
);
1240 var version
: UInt8
; fnlen
: UInt16
; mypos
: UInt64
;
1242 mypos
:= s
.Position
;
1243 fnlen
:= Length(name
);
1244 if IsASCII(name
) = False then
1245 flags
:= flags
or ZIP_UTF8_MASK
;
1246 version
:= GetZIPVersion(name
, flags
, comp
);
1247 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1249 e_WriteLog('==============================================', MSG_NOTIFY
);
1250 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Min Version : ' + IntToStr(version
), MSG_NOTIFY
);
1251 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Min System : ' + IntToStr(ZIP_SYSTEM
), MSG_NOTIFY
);
1252 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Flags : $' + IntToHex(flags
, 4), MSG_NOTIFY
);
1253 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Compression : ' + IntToStr(comp
), MSG_NOTIFY
);
1254 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Modification Time : ' + DosToStr(mtime
), MSG_NOTIFY
);
1255 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': CRC-32 : $' + IntToHex(crc
, 8), MSG_NOTIFY
);
1256 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Compressed size : ' + IntToStr(csize
), MSG_NOTIFY
);
1257 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Decompressed size : ' + IntToStr(usize
), MSG_NOTIFY
);
1258 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Name Length : ' + IntToStr(fnlen
), MSG_NOTIFY
);
1259 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Extension Length : ' + IntToStr(0), MSG_NOTIFY
);
1260 e_WriteLog('LFH @' + IntToHex(mypos
, 8) + ': Name : "' + name
+ '"', MSG_NOTIFY
);
1262 s
.WriteBuffer(ZIP_SIGN_LFH
, 4); // LFH Signature
1263 s
.WriteByte(version
); // Min version
1264 s
.WriteByte(ZIP_SYSTEM
); // System
1265 WriteInt(s
, UInt16(flags
)); // Flags
1266 WriteInt(s
, UInt16(comp
)); // Compression method
1267 WriteInt(s
, UInt32(mtime
)); // Modification time/date
1268 WriteInt(s
, UInt32(crc
)); // CRC-32
1269 WriteInt(s
, UInt32(csize
)); // Compressed size
1270 WriteInt(s
, UInt32(usize
)); // Decompressed size
1271 WriteInt(s
, UInt16(fnlen
)); // Name field length
1272 WriteInt(s
, UInt16(0)); // Extra field length
1273 s
.WriteBuffer(name
[1], fnlen
); // File Name
1276 procedure TZIPEditor
.WriteCDR(s
: TStream
; flags
, comp
, mtime
, crc
, csize
, usize
, eattr
, offset
: UInt32
; const name
, com
: AnsiString
; cdrid
: Integer);
1277 var version
: UInt8
; fnlen
, fclen
: UInt16
; mypos
: UInt64
;
1279 mypos
:= s
.Position
;
1280 fnlen
:= Length(name
);
1281 fclen
:= Length(com
);
1282 if (IsASCII(name
) = False) or (IsASCII(com
) = False) then
1283 flags
:= flags
or ZIP_UTF8_MASK
;
1284 version
:= GetZIPVersion(name
, flags
, comp
);
1285 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1287 e_WriteLog('==============================================', MSG_NOTIFY
);
1288 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Writer Version : ' + IntToStr(ZIP_MAXVERSION
), MSG_NOTIFY
);
1289 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Writer System : ' + IntToStr(ZIP_SYSTEM
), MSG_NOTIFY
);
1290 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Min Version : ' + IntToStr(version
), MSG_NOTIFY
);
1291 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Min System : ' + IntToStr(ZIP_SYSTEM
), MSG_NOTIFY
);
1292 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Flags : $' + IntToHex(flags
, 4), MSG_NOTIFY
);
1293 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Compression : ' + IntToStr(comp
), MSG_NOTIFY
);
1294 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Modification Time : ' + DosToStr(mtime
), MSG_NOTIFY
);
1295 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': CRC-32 : $' + IntToHex(crc
, 8), MSG_NOTIFY
);
1296 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Compressed size : ' + IntToStr(csize
), MSG_NOTIFY
);
1297 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Decompressed size : ' + IntToStr(usize
), MSG_NOTIFY
);
1298 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Name Length : ' + IntToStr(fnlen
), MSG_NOTIFY
);
1299 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Extension Length : ' + IntToStr(0), MSG_NOTIFY
);
1300 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Comment Length : ' + IntToStr(fclen
), MSG_NOTIFY
);
1301 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Disk : ' + IntToStr(0), MSG_NOTIFY
);
1302 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Internal Attrib : $' + IntToHex(0, 4), MSG_NOTIFY
);
1303 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': External Attrib : $' + IntToHex(eattr
, 8), MSG_NOTIFY
);
1304 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': LFH Offset : $' + IntToHex(offset
, 8), MSG_NOTIFY
);
1305 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Name : "' + name
+ '"', MSG_NOTIFY
);
1306 e_WriteLog('CDR#' + IntToStr(cdrid
) + ' @' + IntToHex(mypos
, 8) + ': Comment : "' + com
+ '"', MSG_NOTIFY
);
1308 s
.WriteBuffer(ZIP_SIGN_CDR
, 4); // CDR Signature
1309 s
.WriteByte(ZIP_MAXVERSION
); // Used version
1310 s
.WriteByte(ZIP_SYSTEM
); // Used system
1311 s
.WriteByte(version
); // Min version
1312 s
.WriteByte(ZIP_SYSTEM
); // Min system
1313 WriteInt(s
, UInt16(flags
)); // Flags
1314 WriteInt(s
, UInt16(comp
)); // Compression method
1315 WriteInt(s
, UInt32(mtime
)); // Modification time/date
1316 WriteInt(s
, UInt32(crc
)); // CRC-32
1317 WriteInt(s
, UInt32(csize
)); // Compressed size
1318 WriteInt(s
, UInt32(usize
)); // Decompressed size
1319 WriteInt(s
, UInt16(fnlen
)); // Name field length
1320 WriteInt(s
, UInt16(0)); // Extra field length
1321 WriteInt(s
, UInt16(fclen
)); // Comment field length
1322 WriteInt(s
, UInt16(0)); // Disk
1323 WriteInt(s
, UInt16(0)); // Internal attributes
1324 WriteInt(s
, UInt32(eattr
)); // External attributes
1325 WriteInt(s
, UInt32(offset
)); // LFH offset
1326 s
.WriteBuffer(name
[1], fnlen
); // File Name
1327 s
.WriteBuffer(com
[1], fclen
); // Comment
1330 procedure TZIPEditor
.SaveToStream(s
: TStream
);
1332 var start
, offset
, loffset
, size
, zcrc
, count
, comlen
: UInt32
;
1334 var afname
: AnsiString
;
1337 // Write LFH headers and data
1338 start
:= s
.Position
;
1339 zcrc
:= crc32(0, nil, 0);
1340 if FSection
<> nil then
1342 for i
:= 0 to High(FSection
) do
1344 if FSection
[i
].list
<> nil then
1346 for j
:= 0 to High(FSection
[i
].list
) do
1348 p
:= @FSection
[i
].list
[j
];
1349 afname
:= GetFileName(FSection
[i
].name
, p
.name
);
1350 WriteLFH(s
, p
.flags
, p
.comp
, p
.mtime
, p
.chksum
, p
.csize
, p
.usize
, afname
);
1351 if p
.stream
<> nil then
1353 Assert(p
.stream
.Size
= p
.csize
);
1354 p
.stream
.SaveToStream(s
);
1356 else if FStream
<> nil then
1358 FStream
.Seek(p
.pos
, TSeekOrigin
.soBeginning
);
1359 s
.CopyFrom(FStream
, p
.csize
);
1363 raise Exception
.Create('No data source available (something very wrong)');
1369 afname
:= GetFileName(FSection
[i
].name
, '');
1370 WriteLFH(s
, 0, ZIP_COMP_STORE
, FSection
[i
].mtime
, zcrc
, 0, 0, afname
);
1374 // Write CDR headers
1377 offset
:= s
.Position
- start
;
1378 if FSection
<> nil then
1380 for i
:= 0 to High(FSection
) do
1382 if FSection
[i
].list
<> nil then
1384 for j
:= 0 to High(FSection
[i
].list
) do
1386 p
:= @FSection
[i
].list
[j
];
1387 afname
:= GetFileName(FSection
[i
].name
, p
.name
);
1388 WriteCDR(s
, p
.flags
, p
.comp
, p
.mtime
, p
.chksum
, p
.csize
, p
.usize
, $00, loffset
, afname
, p
.comment
, i
);
1389 loffset
:= loffset
+ 30 + Length(afname
) + p
.csize
;
1395 afname
:= GetFileName(FSection
[i
].name
, '');
1396 WriteCDR(s
, 0, ZIP_COMP_STORE
, FSection
[i
].mtime
, zcrc
, 0, 0, $10, loffset
, afname
, FSection
[i
].comment
, i
);
1397 loffset
:= loffset
+ 30 + Length(afname
) + 0;
1402 Assert(loffset
= offset
);
1403 Assert(count
< $ffff);
1404 size
:= s
.Position
- start
- offset
;
1405 // Write EOCD header
1406 mypos
:= s
.Position
;
1407 comlen
:= Length(FComment
);
1408 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
1410 e_WriteLog('==============================================', MSG_NOTIFY
);
1411 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Disk ID : ' + IntToStr(0), MSG_NOTIFY
);
1412 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Disk ID with CD : ' + IntToStr(0), MSG_NOTIFY
);
1413 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Available CDR''s : ' + IntToStr(count
), MSG_NOTIFY
);
1414 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Total CDR''s : ' + IntToStr(count
), MSG_NOTIFY
);
1415 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': CD Length : ' + IntToStr(size
), MSG_NOTIFY
);
1416 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': CD Offset : $' + IntToHex(offset
, 8), MSG_NOTIFY
);
1417 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Comment Length : ' + IntToStr(comlen
), MSG_NOTIFY
);
1418 e_WriteLog('EOCD @' + IntToHex(mypos
, 8) + ': Comment : "' + FComment
+ '"', MSG_NOTIFY
);
1419 e_WriteLog('==============================================', MSG_NOTIFY
);
1421 s
.WriteBuffer(ZIP_SIGN_EOCD
, 4); // EOCD Signature
1422 WriteInt(s
, UInt16(0)); // Disk
1423 WriteInt(s
, UInt16(0)); // Num of Disks
1424 WriteInt(s
, UInt16(count
)); // Num of CDRs
1425 WriteInt(s
, UInt16(count
)); // Total CDR entries
1426 WriteInt(s
, UInt32(size
)); // Central Directory size
1427 WriteInt(s
, UInt32(offset
)); // Central Directory offset
1428 WriteInt(s
, UInt16(comlen
)); // Comment field length
1429 s
.WriteBuffer(FComment
[1], comlen
); // Comment
1432 procedure TZIPEditor
.SaveTo(FileName
: String);
1436 s
:= TFileStream
.Create(FileName
, fmCreate
);
1445 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
1446 e_WriteLog('ZIP: Failed to create file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
1452 function TZIPEditor
.GetLastError
: Integer;
1454 Result
:= FLastError
;
1457 function TZIPEditor
.GetLastErrorStr
: String;
1460 DFWAD_NOERROR
: Result
:= '';
1461 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFZIP file not found';
1462 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFZIP file';
1463 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
1464 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFZIP';
1465 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFZIP file is not loaded';
1466 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
1467 DFWAD_ERROR_READWAD
: Result
:= 'Read DFZIP error';
1468 otherwise Result
:= IntToStr(FLastError
);
1472 function TZIPEditor
.GetResourcesCount
: Word;
1476 if FSection
<> nil then
1478 Result
:= Result
+ Length(FSection
);
1479 for i
:= 0 to High(FSection
) do
1480 if FSection
[i
].list
<> nil then
1481 Result
:= Result
+ Length(FSection
[i
].list
);
1485 function TZIPEditor
.GetVersion
: Byte;
1491 gWADEditorFactory
.RegisterEditor('DFZIP', TZIPEditor
);