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 // simple grouping files w/o packing:
6 // wad, doom : DooM .WAD (IWAD, PWAD)
7 // pak, quake : Quake I/II .PAK (PACK)
8 // grp, duke3d : Duke3D .GRP (KenSilverman)
9 // spe, spec, abuse: Abuse .SPE (SPEC1.0)
10 // wad2 : Quake .WAD (WAD2)
11 // allegro : DOS Allegro (slh.ALL.; ALL.)
12 // dune2 pak : alas, no signature %-(
14 // sin : SiN .SIN (SPAK)
16 {.$DEFINE SFS_PLAIN_FS_ALTERNATIVE_SPEC}
17 // define this and the first byte of each file in .SPE will contain
19 // undefine this and file type will be directory name.
20 {.$DEFINE SFS_PLAIN_FS_DEBUG_ALLEGRO}
21 {.$DEFINE SFS_PLAINFS_FULL}
29 SysUtils
, Classes
, Contnrs
, sfs
;
37 {$IFDEF SFS_PLAINFS_FULL}
48 TSFSPlainVolume
= class (TSFSVolume
)
50 fType
: TSFSPlainVolumeType
;
52 procedure PAKReadDirectory ();
53 procedure SINReadDirectory ();
54 {$IFDEF SFS_PLAINFS_FULL}
55 procedure WADReadDirectory ();
56 procedure GRPReadDirectory ();
57 procedure SPEReadDirectory ();
58 procedure WAD2ReadDirectory ();
59 procedure ALLReadDirectory ();
60 procedure Dune2ReadDirectory ();
61 procedure MAXReadDirectory ();
64 procedure ReadDirectory (); override;
67 function OpenFileByIndex (const index
: Integer): TStream
; override;
70 TSFSPlainVolumeFactory
= class (TSFSVolumeFactory
)
72 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
73 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
74 procedure Recycle (vol
: TSFSVolume
); override;
86 TSFSExtFileInfo
= class (TSFSFileInfo
)
88 fVBuf
: packed array of Byte;
92 {$IFDEF SFS_PLAINFS_FULL}
93 TAllegroProperty
= class
101 function ReadMD (st
: TStream
): Integer;
102 // read dword in big-endian format. portable.
104 buf
: packed array [0..3] of Byte;
106 st
.ReadBuffer(buf
[0], 4);
107 result
:= (buf
[0] shl 24) or (buf
[1] shl 16) or (buf
[2] shl 8) or buf
[3];
110 {$IFDEF SFS_PLAINFS_FULL}
111 function WADCheckMagic (st
: TStream
): Boolean;
113 sign
: packed array [0..3] of Char;
117 st
.ReadBuffer(sign
[0], 4);
118 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
119 st
.Seek(-12, soCurrent
);
120 if (sign
<> 'IWAD') and (sign
<> 'PWAD') then exit
;
121 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
122 (dofs
+fcnt
*16 > st
.Size
) then exit
;
127 function PAKCheckMagic (st
: TStream
): Boolean;
129 sign
: packed array [0..3] of Char;
130 dsize
, dofs
: Integer;
133 st
.ReadBuffer(sign
[0], 4);
134 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
135 st
.Seek(-12, soCurrent
);
136 if sign
<> 'PACK' then exit
;
137 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
138 (dsize
mod 64 <> 0) then exit
;
142 function SINCheckMagic (st
: TStream
): Boolean;
144 sign
: packed array [0..3] of Char;
145 dsize
, dofs
: Integer;
148 st
.ReadBuffer(sign
[0], 4);
149 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
150 st
.Seek(-12, soCurrent
);
151 if sign
<> 'SPAK' then exit
;
152 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
153 (dsize
mod 64 <> 0) then exit
;
157 {$IFDEF SFS_PLAINFS_FULL}
158 function GRPCheckMagic (st
: TStream
): Boolean;
160 sign
: packed array [0..11] of Char;
164 st
.ReadBuffer(sign
[0], 12);
165 st
.ReadBuffer(fcnt
, 4);
166 st
.Seek(-16, soCurrent
);
167 if sign
<> 'KenSilverman' then exit
;
168 if (fcnt
< 0) or (fcnt
*16 > st
.Size
-16) then exit
;
172 function SPECheckMagic (st
: TStream
): Boolean;
174 sign
: packed array [0..6] of Char;
179 st
.ReadBuffer(sign
[0], 7); st
.ReadBuffer(b
, 1);
180 st
.ReadBuffer(fcnt
, 4);
181 st
.Seek(-12, soCurrent
);
182 if (sign
<> 'SPEC1.0') or (b
<> 0) or (fcnt
< 0) then exit
;
186 function WAD2CheckMagic (st
: TStream
): Boolean;
188 sign
: packed array [0..3] of Char;
192 st
.ReadBuffer(sign
[0], 4);
193 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
194 st
.Seek(-12, soCurrent
);
195 if sign
<> 'WAD2' then exit
;
196 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
197 (dofs
+fcnt
*32 > st
.Size
) then exit
;
201 function ALLCheckMagic (st
: TStream
): Boolean;
203 sign0
, sign1
: packed array [0..3] of Char;
206 st
.ReadBuffer(sign0
[0], 4);
207 st
.ReadBuffer(sign1
[0], 4);
208 st
.Seek(-8, soCurrent
);
209 if sign0
= 'slh.' then
211 if sign1
<> 'ALL.' then exit
;
212 end else if sign0
<> 'ALL.' then exit
;
216 function Dune2CheckMagic (st
: TStream
): Boolean;
218 cpos
, np
, f
: Integer;
221 st
.ReadBuffer(np
, 4);
228 function MAXCheckMagic (st
: TStream
): Boolean;
230 sign
: packed array [0..3] of Char;
234 st
.ReadBuffer(sign
[0], 4);
235 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(fcnt
, 4);
236 st
.Seek(-12, soCurrent
);
237 if sign
<> 'RES0' then exit
;
238 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
239 (dofs
+fcnt
> st
.Size
) then exit
;
246 {$IFDEF SFS_PLAINFS_FULL}
247 procedure TSFSPlainVolume
.WADReadDirectory ();
252 name
: packed array [0..9] of Char;
254 fFileStream
.Seek(4, soCurrent
); // skip signature
255 fFileStream
.ReadBuffer(fcnt
, 4);
256 fFileStream
.ReadBuffer(dofs
, 4);
257 fFileStream
.Position
:= dofs
;
260 fi
:= TSFSFileInfo
.Create(self
);
261 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
262 fFileStream
.ReadBuffer(fi
.fSize
, 4);
263 FillChar(name
[0], Length(name
), 0);
264 fFileStream
.ReadBuffer(name
[0], 8);
265 fi
.fName
:= PChar(@name
[0]);
271 procedure TSFSPlainVolume
.PAKReadDirectory ();
273 dsize
, dofs
: LongWord;
275 name
: packed array [0..56] of Char;
277 fFileStream
.Seek(4, soCurrent
); // skip signature
278 fFileStream
.ReadBuffer(dofs
, 4);
279 fFileStream
.ReadBuffer(dsize
, 4);
280 fFileStream
.Position
:= dofs
;
283 fi
:= TSFSFileInfo
.Create(self
);
284 FillChar(name
[0], Length(name
), 0);
285 fFileStream
.ReadBuffer(name
[0], 56);
286 fi
.fName
:= PChar(@name
[0]);
287 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
288 fFileStream
.ReadBuffer(fi
.fSize
, 4);
293 procedure TSFSPlainVolume
.SINReadDirectory ();
295 dsize
, dofs
: LongWord;
297 name
: packed array [0..120] of Char;
299 fFileStream
.Seek(4, soCurrent
); // skip signature
300 fFileStream
.ReadBuffer(dofs
, 4);
301 fFileStream
.ReadBuffer(dsize
, 4);
302 fFileStream
.Position
:= dofs
;
303 while dsize
>= 128 do
305 fi
:= TSFSFileInfo
.Create(self
);
306 FillChar(name
[0], Length(name
), 0);
307 fFileStream
.ReadBuffer(name
[0], 120);
308 fi
.fName
:= PChar(@name
[0]);
309 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
310 fFileStream
.ReadBuffer(fi
.fSize
, 4);
315 {$IFDEF SFS_PLAINFS_FULL}
316 procedure TSFSPlainVolume
.GRPReadDirectory ();
320 name
: packed array [0..12] of Char;
323 fFileStream
.Seek(12, soCurrent
); // skip signature
324 fFileStream
.ReadBuffer(fcnt
, 4);
325 ofs
:= fFileStream
.Position
+fcnt
*16;
328 fi
:= TSFSFileInfo
.Create(self
);
330 FillChar(name
[0], Length(name
), 0);
331 fFileStream
.ReadBuffer(name
[0], 12);
332 fi
.fName
:= PChar(@name
[0]);
333 fFileStream
.ReadBuffer(fi
.fSize
, 4);
339 procedure TSFSPlainVolume
.SPEReadDirectory ();
343 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
349 wasUnfixedLink
: Boolean;
351 fFileStream
.Seek(8, soCurrent
); // skip signature
352 fFileStream
.ReadBuffer(fcnt
, 2);
355 fi
:= TSFSExtFileInfo
.Create(self
);
356 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
357 SetLength(fi
.fVBuf
, 1); fFileStream
.ReadBuffer(fi
.fVBuf
[0], 1);
359 SetLength(fi
.fVBuf
, 0);
360 fFileStream
.ReadBuffer(b
, 1);
361 pp
:= IntToHex(b
, 2)+'/';
363 fFileStream
.ReadBuffer(name
[0], 1);
364 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
365 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
366 fi
.fName
:= SFSReplacePathDelims(name
, '/');
367 if fi
.fName
= '' then fi
.fName
:= 'untitled_file';
368 if fi
.fName
[1] = '/' then Delete(fi
.fName
, 1, 1);
369 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
370 fi
.fName
:= pp
+fi
.fName
;
372 fFileStream
.ReadBuffer(b
, 1);
373 if (b
and $01) <> 0 then
376 fFileStream
.ReadBuffer(name
[0], 1);
377 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
378 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
379 if name
[0] = #0 then name
:= #0;
385 fFileStream
.ReadBuffer(fi
.fSize
, 4);
386 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
387 Inc(fi
.fSize
); // plus type byte
389 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
395 // nobody uses this shit, but it was documented by JC. %-)
396 // i even allow links to links! %-)
397 wasUnfixedLink
:= true;
398 while wasUnfixedLink
do
400 f
:= 0; wasUnfixedLink
:= false;
401 while f
< fFiles
.Count
do
403 fi
:= TSFSExtFileInfo(fFiles
[f
]); Inc(f
);
404 if (fi
= nil) or (fi
.fLink
= '') then continue
;
406 while c
< fFiles
.Count
do
410 // link can't be linked to itself
411 if SFSStrEqu(TSFSExtFileInfo(fFiles
[c
]).fName
, fi
.fLink
) then break
;
415 if c
< fFiles
.Count
then
417 if TSFSExtFileInfo(fFiles
[c
]).fLink
<> '' then wasUnfixedLink
:= true
420 TSFSExtFileInfo(fFiles
[c
]).fOfs
:= fi
.fOfs
;
421 TSFSExtFileInfo(fFiles
[c
]).fSize
:= fi
.fSize
;
422 TSFSExtFileInfo(fFiles
[c
]).fLink
:= '';
425 else begin Dec(f
); fFiles
.Delete(f
); end; // invalid link
430 procedure TSFSPlainVolume
.WAD2ReadDirectory ();
432 fcnt
, dofs
: LongWord;
434 name
: packed array [0..16] of Char;
437 fFileStream
.Seek(4, soCurrent
); // skip signature
438 fFileStream
.ReadBuffer(fcnt
, 4);
439 fFileStream
.ReadBuffer(dofs
, 4);
440 fFileStream
.Position
:= dofs
;
443 fi
:= TSFSFileInfo
.Create(self
);
444 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
445 fFileStream
.ReadBuffer(fi
.fSize
, 4);
446 fFileStream
.ReadBuffer(f
, 4);
447 fFileStream
.ReadBuffer(c
, 4);
448 FillChar(name
[0], Length(name
), 0);
449 fFileStream
.ReadBuffer(name
[0], 16);
450 fi
.fName
:= PChar(@name
[0]);
455 procedure TSFSPlainVolume
.ALLReadDirectory ();
459 sign
: packed array [0..3] of Char;
460 nameList
: TStringList
;
461 propList
: TObjectList
;
464 prp
: TAllegroProperty
;
466 nameList
:= TStringList
.Create(); propList
:= nil;
468 propList
:= TObjectList
.Create(true);
469 fFileStream
.ReadBuffer(sign
[0], 4);
470 if sign
[0] = 's' then fFileStream
.ReadBuffer(sign
[0], 4);
472 fcnt
:= ReadMD(fFileStream
);
475 // collect properties
476 nameList
.Clear(); propList
.Clear();
478 fFileStream
.ReadBuffer(sign
[0], 4);
479 if sign
<> 'prop' then break
;
480 fFileStream
.ReadBuffer(sign
[0], 4);
481 f
:= ReadMD(fFileStream
); // size
484 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
485 WriteLn(ErrOutput
, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream
.Position
-8, 8));
487 raise ESFSError
.Create('invalid ALLEGRO file');
489 if sign
= 'NAME' then
491 if f
> 255 then c
:= 255 else c
:= f
;
492 FillChar(name
, SizeOf(name
), 0);
493 fFileStream
.ReadBuffer(name
[1], c
); name
[0] := chr(c
);
495 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
500 prp
:= TAllegroProperty
.Create();
501 Move(sign
[0], name
[1], 4); name
[0] := #4;
502 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
504 prp
.ofs
:= fFileStream
.Position
;
508 fFileStream
.Seek(f
, soCurrent
);
510 if nameList
.Count
= 0 then nameList
.Add('untitled_file');
512 Move(sign
[0], name
[1], 4); name
[5] := #0;
513 f
:= 1; while (f
<= 4) and (name
[f
] <> #0) do Inc(f
);
514 while (f
> 0) and (name
[f
] <= ' ') do Dec(f
);
518 f
:= ReadMD(fFileStream
);
519 c
:= ReadMD(fFileStream
);
522 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
523 WriteLn(ErrOutput
, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream
.Position
-8, 8));
525 raise ESFSError
.Create('invalid ALLEGRO file');
529 while nameList
.Count
> 0 do
531 fi
:= TSFSFileInfo
.Create(self
);
532 fi
.fName
:= nameList
[0];
535 fi
.fOfs
:= fFileStream
.Position
;
537 for f
:= 0 to propList
.Count
-1 do
539 prp
:= TAllegroProperty(propList
[f
]);
540 fi
:= TSFSFileInfo
.Create(self
);
541 fi
.fName
:= prp
.name
;
542 fi
.fPath
:= name
+'.props/'+nameList
[0];
543 fi
.fSize
:= prp
.size
;
548 fFileStream
.Seek(c
, soCurrent
);
551 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
552 WriteLn(ErrOutput
, 'ALLEGRO: ok');
560 procedure TSFSPlainVolume
.Dune2ReadDirectory ();
568 fFileStream
.ReadBuffer(ofs
, 4);
569 if ofs
= 0 then break
;
571 fFileStream
.ReadBuffer(ch
, 1);
574 if name
[0] <> #255 then
576 Inc(name
[0]); name
[ord(name
[0])] := ch
;
578 fFileStream
.ReadBuffer(ch
, 1);
580 if fFiles
.Count
> 0 then
582 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
583 fi
.fSize
:= ofs
-fi
.fOfs
;
585 fi
:= TSFSFileInfo
.Create(self
);
590 if fFiles
.Count
> 0 then
592 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
593 fi
.fSize
:= fFileStream
.Size
-fi
.fOfs
;
597 procedure TSFSPlainVolume
.MAXReadDirectory ();
602 name
: packed array [0..9] of Char;
604 fFileStream
.Seek(4, soCurrent
); // skip signature
605 fFileStream
.ReadBuffer(dofs
, 4);
606 fFileStream
.ReadBuffer(fcnt
, 4);
607 fFileStream
.Position
:= dofs
;
610 fi
:= TSFSFileInfo
.Create(self
);
611 FillChar(name
[0], Length(name
), 0);
612 fFileStream
.ReadBuffer(name
[0], 8);
613 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
614 fFileStream
.ReadBuffer(fi
.fSize
, 4);
615 fi
.fName
:= PChar(@name
[0]);
621 procedure TSFSPlainVolume
.ReadDirectory ();
624 sfspvPAK
: PAKReadDirectory();
625 sfspvSIN
: SINReadDirectory();
626 {$IFDEF SFS_PLAINFS_FULL}
627 sfspvWAD
: WADReadDirectory();
628 sfspvGRP
: GRPReadDirectory();
629 sfspvSPE
: SPEReadDirectory();
630 sfspvWAD2
: WAD2ReadDirectory();
631 sfspvALL
: ALLReadDirectory();
632 sfspvDune2
: Dune2ReadDirectory();
633 sfspvMAX
: MAXReadDirectory();
635 else raise ESFSError
.Create('invalid plain SFS');
639 function TSFSPlainVolume
.OpenFileByIndex (const index
: Integer): TStream
;
644 result
:= nil; fs
:= nil;
645 if fFiles
= nil then exit
;
646 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
647 if not (fFiles
[index
] is TSFSExtFileInfo
) or
648 (Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
) < 1) then
653 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
658 result
:= TSFSPartialStream
.Create(fs
,
659 TSFSFileInfo(fFiles
[index
]).fOfs
,
660 TSFSFileInfo(fFiles
[index
]).fSize
, kill
);
662 if kill
then FreeAndNil(fs
);
671 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
676 result
:= TSFSPartialStream
.Create(fs
,
677 TSFSExtFileInfo(fFiles
[index
]).fOfs
,
678 TSFSExtFileInfo(fFiles
[index
]).fSize
-Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
),
680 @(TSFSExtFileInfo(fFiles
[index
]).fVBuf
[0]),
681 Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
));
683 if kill
then FreeAndNil(fs
);
690 { TSFSPlainVolumeFactory }
691 function TSFSPlainVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
694 SFSStrEqu(prefix
, 'pak') or
695 SFSStrEqu(prefix
, 'sin') or
696 SFSStrEqu(prefix
, 'quake')
697 {$IFDEF SFS_PLAINFS_FULL}
699 SFSStrEqu(prefix
, 'wad') or // sorry
700 SFSStrEqu(prefix
, 'wad2') or
701 SFSStrEqu(prefix
, 'grp') or
702 SFSStrEqu(prefix
, 'spe') or
703 SFSStrEqu(prefix
, 'spec') or
704 SFSStrEqu(prefix
, 'doom') or
705 SFSStrEqu(prefix
, 'duke3d') or
706 SFSStrEqu(prefix
, 'abuse') or
707 SFSStrEqu(prefix
, 'allegro') or
708 SFSStrEqu(prefix
, 'dune2') or
709 SFSStrEqu(prefix
, 'max')
714 procedure TSFSPlainVolumeFactory
.Recycle (vol
: TSFSVolume
);
719 function TSFSPlainVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
721 vt
: TSFSPlainVolumeType
;
724 if PAKCheckMagic(st
) then vt
:= sfspvPAK
725 else if SINCheckMagic(st
) then vt
:= sfspvSIN
726 {$IFDEF SFS_PLAINFS_FULL}
727 else if WADCheckMagic(st
) then vt
:= sfspvWAD
728 else if GRPCheckMagic(st
) then vt
:= sfspvGRP
729 else if SPECheckMagic(st
) then vt
:= sfspvSPE
730 else if WAD2CheckMagic(st
) then vt
:= sfspvWAD2
731 //else if ALLCheckMagic(st) then vt := sfspvALL
732 else if MAXCheckMagic(st
) then vt
:= sfspvMAX
733 //else if Dune2CheckMagic(st) then vt := sfspvDune2 // this must be the last!
737 if vt
<> sfspvNone
then
739 result
:= TSFSPlainVolume
.Create(fileName
, st
);
740 TSFSPlainVolume(result
).fType
:= vt
;
742 result
.DoDirectoryRead();
753 pakf
: TSFSPlainVolumeFactory
;
755 pakf
:= TSFSPlainVolumeFactory
.Create();
756 SFSRegisterVolumeFactory(pakf
);
758 // SFSUnregisterVolumeFactory(pakf);