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, jar: PKZIP-compatible archives (store, deflate)
7 // fout2 : Fallout II .DAT
8 // vtdb : Asphyre's VTDb
9 // dfwad : D2D:F wad archives
11 {.$DEFINE SFS_DEBUG_ZIPFS}
19 SysUtils
, Classes
, Contnrs
, sfs
;
24 TSFSZipVolumeType
= (sfszvNone
, sfszvZIP
, sfszvF2DAT
, sfszvVTDB
, sfszvDFWAD
);
26 TSFSZipVolume
= class(TSFSVolume
)
28 fType
: TSFSZipVolumeType
;
30 procedure ZIPReadDirectory ();
31 procedure F2DATReadDirectory ();
32 procedure VTDBReadDirectory ();
33 procedure DFWADReadDirectory ();
35 procedure ReadDirectory (); override;
38 function OpenFileByIndex (const index
: Integer): TStream
; override;
41 TSFSZipVolumeFactory
= class (TSFSVolumeFactory
)
43 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
44 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
45 procedure Recycle (vol
: TSFSVolume
); override;
57 TZDecompressionStream
= TDecompressionStream
;
60 TSFSZipFileInfo
= class (TSFSFileInfo
)
62 fMethod
: Byte; // 0: store; 8: deflate; 255: other
66 TZLocalFileHeader
= packed record
80 function ZIPCheckMagic (st
: TStream
): Boolean;
82 sign
: packed array [0..3] of Char;
85 st
.ReadBuffer(sign
[0], 4);
86 st
.Seek(-4, soCurrent
);
87 if (sign
<> 'PK'#3#4) and (sign
<> 'PK'#5#6) then exit
;
91 function F2DATCheckMagic (st
: TStream
): Boolean;
96 st
.Position
:= st
.Size
-8;
97 st
.ReadBuffer(dsize
, 4); st
.ReadBuffer(fiSz
, 4);
99 if (fiSz
<> st
.Size
) or (dsize
< 5+13) or (dsize
> fiSz
-4) then exit
;
103 function VTDBCheckMagic (st
: TStream
): Boolean;
105 sign
: packed array [0..3] of Char;
109 if st
.Size
< 32 then exit
;
110 st
.ReadBuffer(sign
[0], 4);
111 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
112 st
.Seek(-12, soCurrent
);
113 if sign
<> 'vtdm' then exit
;
114 if (fcnt
< 0) or (dofs
< 32) or (dofs
+fcnt
*8 > st
.Size
) then exit
;
118 function DFWADCheckMagic (st
: TStream
): Boolean;
120 sign
: packed array [0..5] of Char;
124 if st
.Size
< 10 then exit
;
125 st
.ReadBuffer(sign
[0], 6);
126 st
.ReadBuffer(fcnt
, 2);
127 st
.Seek(-8, soCurrent
);
128 //writeln('trying DFWAD... [', sign, ']');
129 if (sign
[0] <> 'D') and (sign
[1] <> 'F') and (sign
[2] <> 'W') and
130 (sign
[3] <> 'A') and (sign
[4] <> 'D') and (sign
[5] <> #
$01) then exit
;
131 //writeln('DFWAD FOUND, with ', fcnt, ' files');
132 //if (fcnt < 0) then exit;
138 procedure TSFSZipVolume
.ZIPReadDirectory ();
142 sign
, dSign
: packed array [0..3] of Char;
143 lhdr
: TZLocalFileHeader
;
144 ignoreFile
, skipped
: Boolean;
145 crc
, psz
, usz
: LongWord;
146 buf
: packed array of Byte;
147 bufPos
, bufUsed
: Integer;
150 // read local directory
152 fFileStream
.ReadBuffer(sign
[0], Length(sign
));
154 if sign
<> 'PK'#3#4 then break
;
156 ignoreFile
:= false; skipped
:= false;
157 fi
:= TSFSZipFileInfo
.Create(self
);
161 fFileStream
.ReadBuffer(lhdr
, SizeOf(lhdr
));
162 if lhdr
.fnameSz
> 255 then name
[0] := #255 else name
[0] := chr(lhdr
.fnameSz
);
163 fFileStream
.ReadBuffer(name
[1], Length(name
));
164 fFileStream
.Seek(lhdr
.fnameSz
-Length(name
), soCurrent
); // rest of the name (if any)
166 fFileStream
.Seek(lhdr
.localExtraSz
, soCurrent
);
168 if (lhdr
.flags
and 1) <> 0 then
170 // encrypted file: skip it
174 if (lhdr
.method
<> 0) and (lhdr
.method
<> 8) then
176 // not stored. not deflated. skip.
180 fi
.fOfs
:= fFileStream
.Position
;
181 fi
.fSize
:= lhdr
.unpackSz
;
182 fi
.fPackSz
:= lhdr
.packSz
;
183 fi
.fMethod
:= lhdr
.method
;
185 if (lhdr
.flags
and (1 shl 3)) <> 0 then
187 // it has a descriptor. stupid thing at all...
188 {$IFDEF SFS_DEBUG_ZIPFS}
189 WriteLn(ErrOutput
, 'descr: $', IntToHex(fFileStream
.Position
, 8));
190 WriteLn(ErrOutput
, 'size: ', lhdr
.unpackSz
);
191 WriteLn(ErrOutput
, 'psize: ', lhdr
.packSz
);
195 if lhdr
.packSz
<> 0 then
197 // some kind of idiot already did our work (maybe paritally)
198 // trust him (her? %-)
199 fFileStream
.Seek(lhdr
.packSz
, soCurrent
);
202 // scan for descriptor
203 if Length(buf
) = 0 then SetLength(buf
, 65536);
204 bufPos
:= 0; bufUsed
:= 0;
205 fFileStream
.ReadBuffer(dSign
[0], 4);
207 if dSign
<> 'PK'#7#8 then
210 Move(dSign
[1], dSign
[0], 3);
211 if bufPos
>= bufUsed
then
215 if fFileStream
.Size
-fFileStream
.Position
> Length(buf
) then
216 bufUsed
:= Length(buf
)
217 else bufUsed
:= fFileStream
.Size
-fFileStream
.Position
;
218 if bufUsed
= 0 then raise ESFSError
.Create('invalid ZIP file');
219 fFileStream
.ReadBuffer(buf
[0], bufUsed
);
221 dSign
[3] := chr(buf
[bufPos
]); Inc(bufPos
);
225 // signature found: check if it is a real one
226 // ???: make stronger check (for the correct following signature)?
227 // sign, crc, packsize, unpacksize
228 fFileStream
.Seek(-bufUsed
+bufPos
, soCurrent
); bufPos
:= 0; bufUsed
:= 0;
229 fFileStream
.ReadBuffer(crc
, 4); // crc
230 fFileStream
.ReadBuffer(psz
, 4); // packed size
232 if psz
= lhdr
.packSz
then
234 // this is a real description. fuck it off
235 fFileStream
.ReadBuffer(usz
, 4); // unpacked size
238 // this is just a sequence of bytes
239 fFileStream
.Seek(-8, soCurrent
);
240 fFileStream
.ReadBuffer(dSign
[0], 4);
243 // store correct values
249 if not skipped
then fFileStream
.Seek(lhdr
.packSz
, soCurrent
);
250 if ignoreFile
then fi
.Free();
253 if (sign
<> 'PK'#1#2) and (sign
<> 'PK'#5#6) then
255 {$IFDEF SFS_DEBUG_ZIPFS}
256 WriteLn(ErrOutput
, 'end: $', IntToHex(fFileStream
.Position
, 8));
257 WriteLn(ErrOutput
, 'sign: $', sign
[0], sign
[1], '#', ord(sign
[2]), '#', ord(sign
[3]));
259 raise ESFSError
.Create('invalid .ZIP archive (no central dir)');
263 procedure TSFSZipVolume
.F2DATReadDirectory ();
271 fFileStream
.Position
:= fFileStream
.Size
-8;
272 fFileStream
.ReadBuffer(dsize
, 4);
273 fFileStream
.Seek(-dsize
, soCurrent
); Dec(dsize
, 4);
276 fi
:= TSFSZipFileInfo
.Create(self
);
277 fFileStream
.ReadBuffer(f
, 4);
278 if (f
< 1) or (f
> 255) then raise ESFSError
.Create('invalid Fallout II .DAT file');
280 if dsize
< 0 then raise ESFSError
.Create('invalid Fallout II .DAT file');
281 name
[0] := chr(f
); if f
> 0 then fFileStream
.ReadBuffer(name
[1], f
);
282 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
284 fFileStream
.ReadBuffer(b
, 1); // packed?
285 if b
= 0 then fi
.fMethod
:= 0 else fi
.fMethod
:= 255;
286 fFileStream
.ReadBuffer(fi
.fSize
, 4);
287 fFileStream
.ReadBuffer(fi
.fPackSz
, 4);
288 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
292 procedure TSFSZipVolume
.VTDBReadDirectory ();
296 keys
: array of record name
: string; ofs
: Integer; end;
301 fFileStream
.Seek(4, soCurrent
); // skip signature
302 fFileStream
.ReadBuffer(fcnt
, 4);
303 fFileStream
.ReadBuffer(dofs
, 4);
304 fFileStream
.Seek(dofs
, soBeginning
);
307 SetLength(keys
, fcnt
);
308 for f
:= 0 to fcnt
-1 do
310 fFileStream
.ReadBuffer(c
, 4);
311 if (c
< 0) or (c
> 1023) then raise ESFSError
.Create('invalid VTDB file');
312 SetLength(keys
[f
].name
, c
);
315 fFileStream
.ReadBuffer(keys
[f
].name
[1], c
);
316 keys
[f
].name
:= SFSReplacePathDelims(keys
[f
].name
, '/');
317 if keys
[f
].name
[1] = '/' then Delete(keys
[f
].name
, 1, 1);
319 fFileStream
.ReadBuffer(keys
[f
].ofs
, 4);
322 // read records (record type will be converted to directory name)
323 for f
:= 0 to fcnt
-1 do
325 fFileStream
.Position
:= keys
[f
].ofs
;
326 fi
:= TSFSZipFileInfo
.Create(self
);
327 fFileStream
.ReadBuffer(rtype
, 2);
328 fFileStream
.ReadBuffer(fi
.fSize
, 4);
329 fFileStream
.ReadBuffer(fi
.fPackSz
, 4);
330 fi
.fOfs
:= fFileStream
.Position
+12;
331 fi
.fName
:= keys
[f
].name
;
332 fi
.fPath
:= IntToHex(rtype
, 4)+'/';
337 procedure TSFSZipVolume
.DFWADReadDirectory ();
342 f
, c
, fofs
, fpksize
: Integer;
343 curpath
, fname
: string;
344 name
: packed array [0..15] of Char;
347 fFileStream
.Seek(6, soCurrent
); // skip signature
348 fFileStream
.ReadBuffer(fcnt
, 2);
349 if fcnt
= 0 then exit
;
351 for f
:= 0 to fcnt
-1 do
353 fFileStream
.ReadBuffer(name
[0], 16);
354 fFileStream
.ReadBuffer(fofs
, 4);
355 fFileStream
.ReadBuffer(fpksize
, 4);
358 while (c
< 16) and (name
[c
] <> #0) do
360 if name
[c
] = '\' then name
[c
] := '/'
361 else if name
[c
] = '/' then name
[c
] := '_';
362 fname
:= fname
+name
[c
];
366 if (fofs
= 0) and (fpksize
= 0) then
368 if length(fname
) <> 0 then fname
:= fname
+'/';
372 if length(fname
) = 0 then continue
; // just in case
373 //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize);
374 // create file record
375 fi
:= TSFSZipFileInfo
.Create(self
);
378 fi
.fPackSz
:= fpksize
;
385 procedure TSFSZipVolume
.ReadDirectory ();
388 sfszvZIP
: ZIPReadDirectory();
389 sfszvF2DAT
: F2DATReadDirectory();
390 sfszvVTDB
: VTDBReadDirectory();
391 sfszvDFWAD
: DFWADReadDirectory();
392 else raise ESFSError
.Create('invalid zipped SFS');
396 function TSFSZipVolume
.OpenFileByIndex (const index
: Integer): TStream
;
398 zs
: TZDecompressionStream
;
402 buf
: packed array [0..1023] of Char;
409 if fFiles
= nil then exit
;
410 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
415 fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
422 if TSFSZipFileInfo(fFiles
[index
]).fMethod
= 0 then
424 result
:= TSFSPartialStream
.Create(fs
,
425 TSFSZipFileInfo(fFiles
[index
]).fOfs
,
426 TSFSZipFileInfo(fFiles
[index
]).fSize
, kill
);
430 fs
.Seek(TSFSZipFileInfo(fFiles
[index
]).fOfs
, soBeginning
);
431 if TSFSZipFileInfo(fFiles
[index
]).fMethod
= 255 then
433 zs
:= TZDecompressionStream
.Create(fs
)
437 zs
:= TZDecompressionStream
.Create(fs
, true {-15}{MAX_WBITS});
439 // sorry, pals, DFWAD is completely broken, so users of it should SUFFER
440 if TSFSZipFileInfo(fFiles
[index
]).fSize
= -1 then
442 TSFSZipFileInfo(fFiles
[index
]).fSize
:= 0;
443 //writeln('trying to determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
447 rd
:= zs
.read(buf
, 1024);
448 //writeln(' got ', rd, ' bytes');
449 if rd
> 0 then Inc(TSFSZipFileInfo(fFiles
[index
]).fSize
, rd
);
450 if rd
< 1024 then break
;
452 //writeln(' resulting size: ', TSFSZipFileInfo(fFiles[index]).fSize, ' bytes');
455 fs
.Seek(TSFSZipFileInfo(fFiles
[index
]).fOfs
, soBeginning
);
456 zs
:= TZDecompressionStream
.Create(fs
)
458 //writeln('*** CAN''T determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
460 if kill
then FreeAndNil(fs
);
465 gs
:= TSFSGuardStream
.Create(zs
, fs
, true, kill
, false);
468 result
:= TSFSPartialStream
.Create(gs
, 0, TSFSZipFileInfo(fFiles
[index
]).fSize
, true);
473 if kill
then FreeAndNil(fs
);
480 { TSFSZipVolumeFactory }
481 function TSFSZipVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
484 (SFSStrComp(prefix
, 'zip') = 0) or
485 (SFSStrComp(prefix
, 'jar') = 0) or
486 (SFSStrComp(prefix
, 'fout2') = 0) or
487 (SFSStrComp(prefix
, 'vtdb') = 0) or
488 (SFSStrComp(prefix
, 'wad') = 0) or
489 (SFSStrComp(prefix
, 'dfwad') = 0);
492 procedure TSFSZipVolumeFactory
.Recycle (vol
: TSFSVolume
);
497 function TSFSZipVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
499 vt
: TSFSZipVolumeType
;
502 if ZIPCheckMagic(st
) then vt
:= sfszvZIP
503 else if DFWADCheckMagic(st
) then vt
:= sfszvDFWAD
504 else if F2DATCheckMagic(st
) then vt
:= sfszvF2DAT
505 else if VTDBCheckMagic(st
) then vt
:= sfszvVTDB
;
507 if vt
<> sfszvNone
then
509 result
:= TSFSZipVolume
.Create(fileName
, st
);
510 TSFSZipVolume(result
).fType
:= vt
;
512 result
.DoDirectoryRead();
513 except {$IFDEF SFS_DEBUG_ZIPFS} on e
: Exception
do begin
514 WriteLn(errOutput
, 'ZIP ERROR: [', e
.ClassName
, ']: ', e
.Message);
518 {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF}
529 zipf
: TSFSZipVolumeFactory
;
531 zipf
:= TSFSZipVolumeFactory
.Create();
532 SFSRegisterVolumeFactory(zipf
);
534 SFSUnregisterVolumeFactory(zipf
);