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}
28 SysUtils
, Classes
, Contnrs
, sfs
;
34 (sfspvNone
, sfspvWAD
, sfspvPAK
, sfspvGRP
, sfspvSPE
, sfspvWAD2
, sfspvALL
,
35 sfspvDune2
, sfspvMAX
, sfspvSIN
);
37 TSFSPlainVolume
= class (TSFSVolume
)
39 fType
: TSFSPlainVolumeType
;
41 procedure PAKReadDirectory ();
42 procedure WADReadDirectory ();
43 procedure GRPReadDirectory ();
44 procedure SPEReadDirectory ();
45 procedure WAD2ReadDirectory ();
46 procedure ALLReadDirectory ();
47 procedure Dune2ReadDirectory ();
48 procedure MAXReadDirectory ();
49 procedure SINReadDirectory ();
51 procedure ReadDirectory (); override;
54 function OpenFileByIndex (const index
: Integer): TStream
; override;
57 TSFSPlainVolumeFactory
= class (TSFSVolumeFactory
)
59 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
60 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
61 procedure Recycle (vol
: TSFSVolume
); override;
73 TSFSExtFileInfo
= class (TSFSFileInfo
)
75 fVBuf
: packed array of Byte;
79 TAllegroProperty
= class
86 function ReadMD (st
: TStream
): Integer;
87 // read dword in big-endian format. portable.
89 buf
: packed array [0..3] of Byte;
91 st
.ReadBuffer(buf
[0], 4);
92 result
:= (buf
[0] shl 24) or (buf
[1] shl 16) or (buf
[2] shl 8) or buf
[3];
95 function WADCheckMagic (st
: TStream
): Boolean;
97 sign
: packed array [0..3] of Char;
101 st
.ReadBuffer(sign
[0], 4);
102 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
103 st
.Seek(-12, soCurrent
);
104 if (sign
<> 'IWAD') and (sign
<> 'PWAD') then exit
;
105 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
106 (dofs
+fcnt
*16 > st
.Size
) then exit
;
110 function PAKCheckMagic (st
: TStream
): Boolean;
112 sign
: packed array [0..3] of Char;
113 dsize
, dofs
: Integer;
116 st
.ReadBuffer(sign
[0], 4);
117 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
118 st
.Seek(-12, soCurrent
);
119 if sign
<> 'PACK' then exit
;
120 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
121 (dsize
mod 64 <> 0) then exit
;
125 function SINCheckMagic (st
: TStream
): Boolean;
127 sign
: packed array [0..3] of Char;
128 dsize
, dofs
: Integer;
131 st
.ReadBuffer(sign
[0], 4);
132 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
133 st
.Seek(-12, soCurrent
);
134 if sign
<> 'SPAK' then exit
;
135 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
136 (dsize
mod 64 <> 0) then exit
;
140 function GRPCheckMagic (st
: TStream
): Boolean;
142 sign
: packed array [0..11] of Char;
146 st
.ReadBuffer(sign
[0], 12);
147 st
.ReadBuffer(fcnt
, 4);
148 st
.Seek(-16, soCurrent
);
149 if sign
<> 'KenSilverman' then exit
;
150 if (fcnt
< 0) or (fcnt
*16 > st
.Size
-16) then exit
;
154 function SPECheckMagic (st
: TStream
): Boolean;
156 sign
: packed array [0..6] of Char;
161 st
.ReadBuffer(sign
[0], 7); st
.ReadBuffer(b
, 1);
162 st
.ReadBuffer(fcnt
, 4);
163 st
.Seek(-12, soCurrent
);
164 if (sign
<> 'SPEC1.0') or (b
<> 0) or (fcnt
< 0) then exit
;
168 function WAD2CheckMagic (st
: TStream
): Boolean;
170 sign
: packed array [0..3] of Char;
174 st
.ReadBuffer(sign
[0], 4);
175 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
176 st
.Seek(-12, soCurrent
);
177 if sign
<> 'WAD2' then exit
;
178 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
179 (dofs
+fcnt
*32 > st
.Size
) then exit
;
183 function ALLCheckMagic (st
: TStream
): Boolean;
185 sign0
, sign1
: packed array [0..3] of Char;
188 st
.ReadBuffer(sign0
[0], 4);
189 st
.ReadBuffer(sign1
[0], 4);
190 st
.Seek(-8, soCurrent
);
191 if sign0
= 'slh.' then
193 if sign1
<> 'ALL.' then exit
;
194 end else if sign0
<> 'ALL.' then exit
;
198 function Dune2CheckMagic (st
: TStream
): Boolean;
200 cpos
, np
, f
: Integer;
203 st
.ReadBuffer(np
, 4);
210 function MAXCheckMagic (st
: TStream
): Boolean;
212 sign
: packed array [0..3] of Char;
216 st
.ReadBuffer(sign
[0], 4);
217 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(fcnt
, 4);
218 st
.Seek(-12, soCurrent
);
219 if sign
<> 'RES0' then exit
;
220 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
221 (dofs
+fcnt
> st
.Size
) then exit
;
227 procedure TSFSPlainVolume
.WADReadDirectory ();
232 name
: packed array [0..9] of Char;
234 fFileStream
.Seek(4, soCurrent
); // skip signature
235 fFileStream
.ReadBuffer(fcnt
, 4);
236 fFileStream
.ReadBuffer(dofs
, 4);
237 fFileStream
.Position
:= dofs
;
240 fi
:= TSFSFileInfo
.Create(self
);
241 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
242 fFileStream
.ReadBuffer(fi
.fSize
, 4);
243 FillChar(name
[0], Length(name
), 0);
244 fFileStream
.ReadBuffer(name
[0], 8);
245 fi
.fName
:= PChar(@name
[0]);
250 procedure TSFSPlainVolume
.PAKReadDirectory ();
252 dsize
, dofs
: LongWord;
254 name
: packed array [0..56] of Char;
256 fFileStream
.Seek(4, soCurrent
); // skip signature
257 fFileStream
.ReadBuffer(dofs
, 4);
258 fFileStream
.ReadBuffer(dsize
, 4);
259 fFileStream
.Position
:= dofs
;
262 fi
:= TSFSFileInfo
.Create(self
);
263 FillChar(name
[0], Length(name
), 0);
264 fFileStream
.ReadBuffer(name
[0], 56);
265 fi
.fName
:= PChar(@name
[0]);
266 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
267 fFileStream
.ReadBuffer(fi
.fSize
, 4);
272 procedure TSFSPlainVolume
.SINReadDirectory ();
274 dsize
, dofs
: LongWord;
276 name
: packed array [0..120] of Char;
278 fFileStream
.Seek(4, soCurrent
); // skip signature
279 fFileStream
.ReadBuffer(dofs
, 4);
280 fFileStream
.ReadBuffer(dsize
, 4);
281 fFileStream
.Position
:= dofs
;
282 while dsize
>= 128 do
284 fi
:= TSFSFileInfo
.Create(self
);
285 FillChar(name
[0], Length(name
), 0);
286 fFileStream
.ReadBuffer(name
[0], 120);
287 fi
.fName
:= PChar(@name
[0]);
288 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
289 fFileStream
.ReadBuffer(fi
.fSize
, 4);
294 procedure TSFSPlainVolume
.GRPReadDirectory ();
298 name
: packed array [0..12] of Char;
301 fFileStream
.Seek(12, soCurrent
); // skip signature
302 fFileStream
.ReadBuffer(fcnt
, 4);
303 ofs
:= fFileStream
.Position
+fcnt
*16;
306 fi
:= TSFSFileInfo
.Create(self
);
308 FillChar(name
[0], Length(name
), 0);
309 fFileStream
.ReadBuffer(name
[0], 12);
310 fi
.fName
:= PChar(@name
[0]);
311 fFileStream
.ReadBuffer(fi
.fSize
, 4);
317 procedure TSFSPlainVolume
.SPEReadDirectory ();
321 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
327 wasUnfixedLink
: Boolean;
329 fFileStream
.Seek(8, soCurrent
); // skip signature
330 fFileStream
.ReadBuffer(fcnt
, 2);
333 fi
:= TSFSExtFileInfo
.Create(self
);
334 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
335 SetLength(fi
.fVBuf
, 1); fFileStream
.ReadBuffer(fi
.fVBuf
[0], 1);
337 SetLength(fi
.fVBuf
, 0);
338 fFileStream
.ReadBuffer(b
, 1);
339 pp
:= IntToHex(b
, 2)+'/';
341 fFileStream
.ReadBuffer(name
[0], 1);
342 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
343 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
344 fi
.fName
:= SFSReplacePathDelims(name
, '/');
345 if fi
.fName
= '' then fi
.fName
:= 'untitled_file';
346 if fi
.fName
[1] = '/' then Delete(fi
.fName
, 1, 1);
347 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
348 fi
.fName
:= pp
+fi
.fName
;
350 fFileStream
.ReadBuffer(b
, 1);
351 if (b
and $01) <> 0 then
354 fFileStream
.ReadBuffer(name
[0], 1);
355 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
356 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
357 if name
[0] = #0 then name
:= #0;
363 fFileStream
.ReadBuffer(fi
.fSize
, 4);
364 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
365 Inc(fi
.fSize
); // plus type byte
367 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
373 // nobody uses this shit, but it was documented by JC. %-)
374 // i even allow links to links! %-)
375 wasUnfixedLink
:= true;
376 while wasUnfixedLink
do
378 f
:= 0; wasUnfixedLink
:= false;
379 while f
< fFiles
.Count
do
381 fi
:= TSFSExtFileInfo(fFiles
[f
]); Inc(f
);
382 if (fi
= nil) or (fi
.fLink
= '') then continue
;
384 while c
< fFiles
.Count
do
388 // link can't be linked to itself
389 if SFSStrComp(TSFSExtFileInfo(fFiles
[c
]).fName
, fi
.fLink
) = 0 then break
;
393 if c
< fFiles
.Count
then
395 if TSFSExtFileInfo(fFiles
[c
]).fLink
<> '' then wasUnfixedLink
:= true
398 TSFSExtFileInfo(fFiles
[c
]).fOfs
:= fi
.fOfs
;
399 TSFSExtFileInfo(fFiles
[c
]).fSize
:= fi
.fSize
;
400 TSFSExtFileInfo(fFiles
[c
]).fLink
:= '';
403 else begin Dec(f
); fFiles
.Delete(f
); end; // invalid link
408 procedure TSFSPlainVolume
.WAD2ReadDirectory ();
410 fcnt
, dofs
: LongWord;
412 name
: packed array [0..16] of Char;
415 fFileStream
.Seek(4, soCurrent
); // skip signature
416 fFileStream
.ReadBuffer(fcnt
, 4);
417 fFileStream
.ReadBuffer(dofs
, 4);
418 fFileStream
.Position
:= dofs
;
421 fi
:= TSFSFileInfo
.Create(self
);
422 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
423 fFileStream
.ReadBuffer(fi
.fSize
, 4);
424 fFileStream
.ReadBuffer(f
, 4);
425 fFileStream
.ReadBuffer(c
, 4);
426 FillChar(name
[0], Length(name
), 0);
427 fFileStream
.ReadBuffer(name
[0], 16);
428 fi
.fName
:= PChar(@name
[0]);
433 procedure TSFSPlainVolume
.ALLReadDirectory ();
437 sign
: packed array [0..3] of Char;
438 nameList
: TStringList
;
439 propList
: TObjectList
;
442 prp
: TAllegroProperty
;
444 nameList
:= TStringList
.Create(); propList
:= nil;
446 propList
:= TObjectList
.Create(true);
447 fFileStream
.ReadBuffer(sign
[0], 4);
448 if sign
[0] = 's' then fFileStream
.ReadBuffer(sign
[0], 4);
450 fcnt
:= ReadMD(fFileStream
);
453 // collect properties
454 nameList
.Clear(); propList
.Clear();
456 fFileStream
.ReadBuffer(sign
[0], 4);
457 if sign
<> 'prop' then break
;
458 fFileStream
.ReadBuffer(sign
[0], 4);
459 f
:= ReadMD(fFileStream
); // size
462 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
463 WriteLn(ErrOutput
, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream
.Position
-8, 8));
465 raise ESFSError
.Create('invalid ALLEGRO file');
467 if sign
= 'NAME' then
469 if f
> 255 then c
:= 255 else c
:= f
;
470 FillChar(name
, SizeOf(name
), 0);
471 fFileStream
.ReadBuffer(name
[1], c
); name
[0] := chr(c
);
473 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
478 prp
:= TAllegroProperty
.Create();
479 Move(sign
[0], name
[1], 4); name
[0] := #4;
480 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
482 prp
.ofs
:= fFileStream
.Position
;
486 fFileStream
.Seek(f
, soCurrent
);
488 if nameList
.Count
= 0 then nameList
.Add('untitled_file');
490 Move(sign
[0], name
[1], 4); name
[5] := #0;
491 f
:= 1; while (f
<= 4) and (name
[f
] <> #0) do Inc(f
);
492 while (f
> 0) and (name
[f
] <= ' ') do Dec(f
);
496 f
:= ReadMD(fFileStream
);
497 c
:= ReadMD(fFileStream
);
500 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
501 WriteLn(ErrOutput
, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream
.Position
-8, 8));
503 raise ESFSError
.Create('invalid ALLEGRO file');
507 while nameList
.Count
> 0 do
509 fi
:= TSFSFileInfo
.Create(self
);
510 fi
.fName
:= nameList
[0];
513 fi
.fOfs
:= fFileStream
.Position
;
515 for f
:= 0 to propList
.Count
-1 do
517 prp
:= TAllegroProperty(propList
[f
]);
518 fi
:= TSFSFileInfo
.Create(self
);
519 fi
.fName
:= prp
.name
;
520 fi
.fPath
:= name
+'.props/'+nameList
[0];
521 fi
.fSize
:= prp
.size
;
526 fFileStream
.Seek(c
, soCurrent
);
529 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
530 WriteLn(ErrOutput
, 'ALLEGRO: ok');
538 procedure TSFSPlainVolume
.Dune2ReadDirectory ();
546 fFileStream
.ReadBuffer(ofs
, 4);
547 if ofs
= 0 then break
;
549 fFileStream
.ReadBuffer(ch
, 1);
552 if name
[0] <> #255 then
554 Inc(name
[0]); name
[ord(name
[0])] := ch
;
556 fFileStream
.ReadBuffer(ch
, 1);
558 if fFiles
.Count
> 0 then
560 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
561 fi
.fSize
:= ofs
-fi
.fOfs
;
563 fi
:= TSFSFileInfo
.Create(self
);
568 if fFiles
.Count
> 0 then
570 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
571 fi
.fSize
:= fFileStream
.Size
-fi
.fOfs
;
575 procedure TSFSPlainVolume
.MAXReadDirectory ();
580 name
: packed array [0..9] of Char;
582 fFileStream
.Seek(4, soCurrent
); // skip signature
583 fFileStream
.ReadBuffer(dofs
, 4);
584 fFileStream
.ReadBuffer(fcnt
, 4);
585 fFileStream
.Position
:= dofs
;
588 fi
:= TSFSFileInfo
.Create(self
);
589 FillChar(name
[0], Length(name
), 0);
590 fFileStream
.ReadBuffer(name
[0], 8);
591 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
592 fFileStream
.ReadBuffer(fi
.fSize
, 4);
593 fi
.fName
:= PChar(@name
[0]);
599 procedure TSFSPlainVolume
.ReadDirectory ();
602 sfspvWAD
: WADReadDirectory();
603 sfspvPAK
: PAKReadDirectory();
604 sfspvGRP
: GRPReadDirectory();
605 sfspvSPE
: SPEReadDirectory();
606 sfspvWAD2
: WAD2ReadDirectory();
607 sfspvALL
: ALLReadDirectory();
608 sfspvDune2
: Dune2ReadDirectory();
609 sfspvMAX
: MAXReadDirectory();
610 sfspvSIN
: SINReadDirectory();
611 else raise ESFSError
.Create('invalid plain SFS');
615 function TSFSPlainVolume
.OpenFileByIndex (const index
: Integer): TStream
;
620 result
:= nil; fs
:= nil;
621 if fFiles
= nil then exit
;
622 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
623 if not (fFiles
[index
] is TSFSExtFileInfo
) or
624 (Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
) < 1) then
629 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
634 result
:= TSFSPartialStream
.Create(fs
,
635 TSFSFileInfo(fFiles
[index
]).fOfs
,
636 TSFSFileInfo(fFiles
[index
]).fSize
, kill
);
638 if kill
then FreeAndNil(fs
);
647 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
652 result
:= TSFSPartialStream
.Create(fs
,
653 TSFSExtFileInfo(fFiles
[index
]).fOfs
,
654 TSFSExtFileInfo(fFiles
[index
]).fSize
-Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
),
656 @(TSFSExtFileInfo(fFiles
[index
]).fVBuf
[0]),
657 Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
));
659 if kill
then FreeAndNil(fs
);
666 { TSFSPlainVolumeFactory }
667 function TSFSPlainVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
670 (SFSStrComp(prefix
, 'pak') = 0) or
671 //(SFSStrComp(prefix, 'wad') = 0) or // sorry
672 (SFSStrComp(prefix
, 'wad2') = 0) or
673 (SFSStrComp(prefix
, 'grp') = 0) or
674 (SFSStrComp(prefix
, 'spe') = 0) or
675 (SFSStrComp(prefix
, 'spec') = 0) or
676 (SFSStrComp(prefix
, 'quake') = 0) or
677 (SFSStrComp(prefix
, 'doom') = 0) or
678 (SFSStrComp(prefix
, 'duke3d') = 0) or
679 (SFSStrComp(prefix
, 'abuse') = 0) or
680 (SFSStrComp(prefix
, 'allegro') = 0) or
681 (SFSStrComp(prefix
, 'dune2') = 0) or
682 (SFSStrComp(prefix
, 'max') = 0) or
683 (SFSStrComp(prefix
, 'sin') = 0);
686 procedure TSFSPlainVolumeFactory
.Recycle (vol
: TSFSVolume
);
691 function TSFSPlainVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
693 vt
: TSFSPlainVolumeType
;
696 if WADCheckMagic(st
) then vt
:= sfspvWAD
697 else if PAKCheckMagic(st
) then vt
:= sfspvPAK
698 else if GRPCheckMagic(st
) then vt
:= sfspvGRP
699 else if SPECheckMagic(st
) then vt
:= sfspvSPE
700 else if WAD2CheckMagic(st
) then vt
:= sfspvWAD2
701 //else if ALLCheckMagic(st) then vt := sfspvALL
702 else if MAXCheckMagic(st
) then vt
:= sfspvMAX
703 else if SINCheckMagic(st
) then vt
:= sfspvSIN
;
704 //else if Dune2CheckMagic(st) then vt := sfspvDune2; // this must be the last!
706 if vt
<> sfspvNone
then
708 result
:= TSFSPlainVolume
.Create(fileName
, st
);
709 TSFSPlainVolume(result
).fType
:= vt
;
711 result
.DoDirectoryRead();
722 pakf
: TSFSPlainVolumeFactory
;
724 pakf
:= TSFSPlainVolumeFactory
.Create();
725 SFSRegisterVolumeFactory(pakf
);
727 SFSUnregisterVolumeFactory(pakf
);