1 // Streaming R/O Virtual File System v0.2.0
2 // Copyright (C) XL A.S. Ketmar. All rights reserved
3 // See the file aplicense.txt for conditions of use.
5 // grouping files with packing:
6 // zip, pk3: PKZIP-compatible archives (store, deflate)
7 // dfwad : D2D:F wad archives
9 {.$DEFINE SFS_DEBUG_ZIPFS}
17 SysUtils
, Classes
, Contnrs
, sfs
;
21 TSFSZipVolumeType
= (sfszvNone
, sfszvZIP
, sfszvDFWAD
);
23 TSFSZipVolume
= class(TSFSVolume
)
25 fType
: TSFSZipVolumeType
;
27 procedure ZIPReadDirectory ();
28 procedure DFWADReadDirectory ();
30 procedure ReadDirectory (); override;
33 function OpenFileByIndex (const index
: Integer): TStream
; override;
36 TSFSZipVolumeFactory
= class(TSFSVolumeFactory
)
38 function IsMyVolumePrefix (const prefix
: AnsiString): Boolean; override;
39 function Produce (const prefix
, fileName
: AnsiString; st
: TStream
): TSFSVolume
; override;
40 procedure Recycle (vol
: TSFSVolume
); override;
51 TSFSZipFileInfo
= class(TSFSFileInfo
)
53 fMethod
: Byte; // 0: store; 8: deflate; 255: other
54 fPackSz
: Int64; // can be -1
57 TZLocalFileHeader
= packed record
70 procedure readLFH (st
: TStream
; var hdr
: TZLocalFileHeader
);
71 {.$IFDEF ENDIAN_LITTLE}
73 hdr
.version
:= readByte(st
);
74 hdr
.hostOS
:= readByte(st
);
75 hdr
.flags
:= readWord(st
);
76 hdr
.method
:= readWord(st
);
77 hdr
.time
:= readLongWord(st
);
78 hdr
.crc
:= readLongWord(st
);
79 hdr
.packSz
:= readLongWord(st
);
80 hdr
.unpackSz
:= readLongWord(st
);
81 hdr
.fnameSz
:= readWord(st
);
82 hdr
.localExtraSz
:= readWord(st
);
86 function ZIPCheckMagic (st
: TStream
): Boolean;
88 sign
: packed array [0..3] of Char;
91 st
.ReadBuffer(sign
[0], 4);
92 st
.Seek(-4, soCurrent
);
93 if (sign
<> 'PK'#3#4) and (sign
<> 'PK'#5#6) then exit
;
98 function DFWADCheckMagic (st
: TStream
): Boolean;
100 sign
: packed array [0..5] of Char;
103 if st
.Size
< 10 then exit
;
104 st
.ReadBuffer(sign
[0], 6);
105 {fcnt :=} readWord(st
);
106 st
.Seek(-8, soCurrent
);
107 if (sign
[0] <> 'D') and (sign
[1] <> 'F') and (sign
[2] <> 'W') and
108 (sign
[3] <> 'A') and (sign
[4] <> 'D') and (sign
[5] <> #
$01) then exit
;
114 procedure TSFSZipVolume
.ZIPReadDirectory ();
117 fname
: AnsiString = '';
118 sign
: packed array [0..3] of Char;
119 lhdr
: TZLocalFileHeader
;
126 cdofs
, hdrofs
: Int64;
128 fileOffsets
: array of Int64 = nil;
129 nameLen
, extraLen
, commentLen
: Word;
130 fileIdx
: Integer = -1;
132 // search for central dir pointer
133 if fFileStream
.size
> 65636 then bufsz
:= 65636 else bufsz
:= fFileStream
.size
;
134 fFileStream
.position
:= fFileStream
.size
-bufsz
;
139 fFileStream
.readBuffer(buf
^, bufsz
);
140 for f
:= bufsz
-16 downto 4 do
142 if (buf
[f
-4] = ord('P')) and (buf
[f
-3] = ord('K')) and (buf
[f
-2] = 5) and (buf
[f
-1] = 6) then
144 cdsize
:= LongWord(buf
[f
+8])+(LongWord(buf
[f
+9])<<8)+(LongWord(buf
[f
+10])<<16)+(LongWord(buf
[f
+11])<<24);
145 cdofs
:= Int64(buf
[f
+12])+(Int64(buf
[f
+13])<<8)+(Int64(buf
[f
+14])<<16)+(Int64(buf
[f
+15])<<24);
153 if (cdofs
>= 0) and (cdsize
> 0) then
155 // wow, we got central directory! process it
156 fFileStream
.position
:= cdofs
;
160 fFileStream
.readBuffer(sign
, 4);
161 if sign
= 'PK'#1#2 then
163 if cdsize
< 42 then break
;
165 // skip uninteresting fields
166 fFileStream
.seek(2+2+2+2+2+2+4+4+4, soCurrent
);
167 nameLen
:= readWord(fFileStream
);
168 extraLen
:= readWord(fFileStream
);
169 commentLen
:= readWord(fFileStream
);
170 // skip uninteresting fields
171 fFileStream
.seek(2+2+4, soCurrent
);
172 hdrofs
:= readLongWord(fFileStream
);
173 // now skip name, extra and comment
174 if cdsize
< nameLen
+extraLen
+commentLen
then break
;
175 Dec(cdsize
, nameLen
+extraLen
+commentLen
);
176 fFileStream
.seek(nameLen
+extraLen
+commentLen
, soCurrent
);
177 SetLength(fileOffsets
, length(fileOffsets
)+1);
178 fileOffsets
[high(fileOffsets
)] := hdrofs
;
179 //writeln('file #', high(fileOffsets), ' found at ', hdrofs);
181 else if sign
= 'PK'#7#8 then
183 if cdsize
< 3*4 then break
;
185 fFileStream
.seek(3*4, soCurrent
);
192 if length(fileOffsets
) = 0 then exit
; // no files at all
197 fFileStream
.position
:= 0;
200 // read local directory
204 if fileIdx
> High(fileOffsets
) then break
;
205 //writeln('reading file #', fileIdx, ' at ', fileOffsets[fileIdx]);
206 fFileStream
.position
:= fileOffsets
[fileIdx
];
212 fFileStream
.ReadBuffer(sign
[0], Length(sign
));
213 // skip data descriptor
214 if sign
= 'PK'#7#8 then
216 fFileStream
.seek(3*4, soCurrent
);
221 if sign
<> 'PK'#3#4 then break
;
225 readLFH(fFileStream
, lhdr
);
227 fi
:= TSFSZipFileInfo
.Create(self
);
231 SetLength(fname
, lhdr
.fnameSz
);
232 if lhdr
.fnameSz
> 0 then
234 fFileStream
.ReadBuffer(fname
[1], length(fname
));
235 fi
.fName
:= utf8to1251(fname
);
238 // here we should process extra field: it may contain utf8 filename
239 while lhdr
.localExtraSz
>= 4 do
241 efid
:= readWord(fFileStream
);
242 efsz
:= readWord(fFileStream
);
243 Dec(lhdr
.localExtraSz
, 4);
244 if efsz
> lhdr
.localExtraSz
then break
;
245 // Info-ZIP Unicode Path Extra Field?
246 if (efid
= $7075) and (efsz
> 5) then
248 fFileStream
.ReadBuffer(izver
, 1);
250 Dec(lhdr
.localExtraSz
, 1);
253 //writeln('!!!!!!!!!!!!');
254 Dec(lhdr
.localExtraSz
, efsz
);
255 fFileStream
.ReadBuffer(izcrc
, 4); // name crc, ignore it for now
257 SetLength(fname
, efsz
);
258 if length(fname
) > 0 then fFileStream
.readBuffer(fname
[1], length(fname
));
259 fi
.fName
:= utf8to1251(fname
);
260 //writeln('++++++ [', fi.fName, ']');
267 fFileStream
.Seek(efsz
, soCurrent
);
268 Dec(lhdr
.localExtraSz
, efsz
);
272 if lhdr
.localExtraSz
> 0 then fFileStream
.Seek(lhdr
.localExtraSz
, soCurrent
);
274 if (lhdr
.flags
and 1) <> 0 then
276 // encrypted file: skip it
280 if (lhdr
.method
<> 0) and (lhdr
.method
<> 8) then
282 // not stored. not deflated. skip.
286 if (length(fi
.fName
) = 0) or (fname
[length(fi
.fName
)] = '/') or (fname
[length(fi
.fName
)] = '\') then
292 for f
:= 1 to length(fi
.fName
) do if fi
.fName
[f
] = '\' then fi
.fName
[f
] := '/';
295 fi
.fOfs
:= fFileStream
.Position
;
296 fi
.fSize
:= lhdr
.unpackSz
;
297 fi
.fPackSz
:= lhdr
.packSz
;
298 fi
.fMethod
:= lhdr
.method
;
299 if fi
.fMethod
= 0 then fi
.fPackSz
:= fi
.fSize
;
302 if fileIdx
< 0 then fFileStream
.Seek(lhdr
.packSz
, soCurrent
);
303 if ignoreFile
then fi
.Free();
306 if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then
308 {$IFDEF SFS_DEBUG_ZIPFS}
309 WriteLn(ErrOutput, 'end: $', IntToHex(fFileStream.Position, 8));
310 WriteLn(ErrOutput, 'sign: $', sign[0], sign[1], '#', ord(sign[2]), '#', ord(sign[3]));
312 raise ESFSError.Create('invalid .ZIP archive (no central dir)');
318 procedure TSFSZipVolume
.DFWADReadDirectory ();
324 fofs
, fpksize
: LongWord;
325 curpath
, fname
: string;
326 name
: packed array [0..15] of Char;
329 fFileStream
.Seek(6, soCurrent
); // skip signature
330 fcnt
:= readWord(fFileStream
);
331 if fcnt
= 0 then exit
;
333 for f
:= 0 to fcnt
-1 do
335 fFileStream
.ReadBuffer(name
[0], 16);
336 fofs
:= readLongWord(fFileStream
);
337 fpksize
:= readLongWord(fFileStream
);
340 while (c
< 16) and (name
[c
] <> #0) do
342 if name
[c
] = '\' then name
[c
] := '/'
343 else if name
[c
] = '/' then name
[c
] := '_';
344 fname
:= fname
+name
[c
];
348 if (fofs
= 0) and (fpksize
= 0) then
350 if length(fname
) <> 0 then fname
:= fname
+'/';
354 if length(fname
) = 0 then continue
; // just in case
355 //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize);
356 // create file record
357 fi
:= TSFSZipFileInfo
.Create(self
);
360 fi
.fPackSz
:= fpksize
;
367 procedure TSFSZipVolume
.ReadDirectory ();
370 sfszvZIP
: ZIPReadDirectory();
371 sfszvDFWAD
: DFWADReadDirectory();
372 else raise ESFSError
.Create('invalid archive');
376 function TSFSZipVolume
.OpenFileByIndex (const index
: Integer): TStream
;
382 if fFiles
= nil then exit
;
383 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
385 if TSFSZipFileInfo(fFiles
[index
]).fMethod
= 0 then
387 result
:= TSFSPartialStream
.Create(fFileStream
, TSFSZipFileInfo(fFiles
[index
]).fOfs
, TSFSZipFileInfo(fFiles
[index
]).fSize
, false);
391 rs
:= TSFSPartialStream
.Create(fFileStream
, TSFSZipFileInfo(fFiles
[index
]).fOfs
, TSFSZipFileInfo(fFiles
[index
]).fPackSz
, false);
392 result
:= TUnZStream
.Create(rs
, TSFSZipFileInfo(fFiles
[index
]).fSize
, true, (TSFSZipFileInfo(fFiles
[index
]).fMethod
<> 255));
402 { TSFSZipVolumeFactory }
403 function TSFSZipVolumeFactory
.IsMyVolumePrefix (const prefix
: AnsiString): Boolean;
406 StrEquCI1251(prefix
, 'zip') or
407 StrEquCI1251(prefix
, 'pk3') or
408 StrEquCI1251(prefix
, 'dfwad');
411 procedure TSFSZipVolumeFactory
.Recycle (vol
: TSFSVolume
);
416 function TSFSZipVolumeFactory
.Produce (const prefix
, fileName
: AnsiString; st
: TStream
): TSFSVolume
;
418 vt
: TSFSZipVolumeType
;
421 if ZIPCheckMagic(st
) then vt
:= sfszvZIP
422 else if DFWADCheckMagic(st
) then vt
:= sfszvDFWAD
;
424 if vt
<> sfszvNone
then
426 result
:= TSFSZipVolume
.Create(fileName
, st
);
427 TSFSZipVolume(result
).fType
:= vt
;
429 result
.DoDirectoryRead();
430 except {$IFDEF SFS_DEBUG_ZIPFS} on e
: Exception
do begin
431 WriteLn(errOutput
, 'ZIP ERROR: [', e
.ClassName
, ']: ', e
.Message);
435 {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF}
446 zipf
: TSFSZipVolumeFactory
;
448 zipf
:= TSFSZipVolumeFactory
.Create();
449 SFSRegisterVolumeFactory(zipf
);
451 // SFSUnregisterVolumeFactory(zipf);