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;
52 function OpenFileByIndex (const index
: Integer): TStream
; override;
55 TSFSPlainVolumeFactory
= class (TSFSVolumeFactory
)
57 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
58 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
59 procedure Recycle (vol
: TSFSVolume
); override;
71 TSFSExtFileInfo
= class (TSFSFileInfo
)
73 fVBuf
: packed array of Byte;
77 TAllegroProperty
= class
84 function ReadMD (st
: TStream
): Integer;
85 // read dword in big-endian format. portable.
87 buf
: packed array [0..3] of Byte;
89 st
.ReadBuffer(buf
[0], 4);
90 result
:= (buf
[0] shl 24) or (buf
[1] shl 16) or (buf
[2] shl 8) or buf
[3];
93 function WADCheckMagic (st
: TStream
): Boolean;
95 sign
: packed array [0..3] of Char;
99 st
.ReadBuffer(sign
[0], 4);
100 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
101 st
.Seek(-12, soCurrent
);
102 if (sign
<> 'IWAD') and (sign
<> 'PWAD') then exit
;
103 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
104 (dofs
+fcnt
*16 > st
.Size
) then exit
;
108 function PAKCheckMagic (st
: TStream
): Boolean;
110 sign
: packed array [0..3] of Char;
111 dsize
, dofs
: Integer;
114 st
.ReadBuffer(sign
[0], 4);
115 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
116 st
.Seek(-12, soCurrent
);
117 if sign
<> 'PACK' then exit
;
118 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
119 (dsize
mod 64 <> 0) then exit
;
123 function SINCheckMagic (st
: TStream
): Boolean;
125 sign
: packed array [0..3] of Char;
126 dsize
, dofs
: Integer;
129 st
.ReadBuffer(sign
[0], 4);
130 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(dsize
, 4);
131 st
.Seek(-12, soCurrent
);
132 if sign
<> 'SPAK' then exit
;
133 if (dsize
< 0) or (dofs
< 0) or (dofs
> st
.Size
) or (dofs
+dsize
> st
.Size
) or
134 (dsize
mod 64 <> 0) then exit
;
138 function GRPCheckMagic (st
: TStream
): Boolean;
140 sign
: packed array [0..11] of Char;
144 st
.ReadBuffer(sign
[0], 12);
145 st
.ReadBuffer(fcnt
, 4);
146 st
.Seek(-16, soCurrent
);
147 if sign
<> 'KenSilverman' then exit
;
148 if (fcnt
< 0) or (fcnt
*16 > st
.Size
-16) then exit
;
152 function SPECheckMagic (st
: TStream
): Boolean;
154 sign
: packed array [0..6] of Char;
159 st
.ReadBuffer(sign
[0], 7); st
.ReadBuffer(b
, 1);
160 st
.ReadBuffer(fcnt
, 4);
161 st
.Seek(-12, soCurrent
);
162 if (sign
<> 'SPEC1.0') or (b
<> 0) or (fcnt
< 0) then exit
;
166 function WAD2CheckMagic (st
: TStream
): Boolean;
168 sign
: packed array [0..3] of Char;
172 st
.ReadBuffer(sign
[0], 4);
173 st
.ReadBuffer(fcnt
, 4); st
.ReadBuffer(dofs
, 4);
174 st
.Seek(-12, soCurrent
);
175 if sign
<> 'WAD2' then exit
;
176 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
177 (dofs
+fcnt
*32 > st
.Size
) then exit
;
181 function ALLCheckMagic (st
: TStream
): Boolean;
183 sign0
, sign1
: packed array [0..3] of Char;
186 st
.ReadBuffer(sign0
[0], 4);
187 st
.ReadBuffer(sign1
[0], 4);
188 st
.Seek(-8, soCurrent
);
189 if sign0
= 'slh.' then
191 if sign1
<> 'ALL.' then exit
;
192 end else if sign0
<> 'ALL.' then exit
;
196 function Dune2CheckMagic (st
: TStream
): Boolean;
198 cpos
, np
, f
: Integer;
201 st
.ReadBuffer(np
, 4);
208 function MAXCheckMagic (st
: TStream
): Boolean;
210 sign
: packed array [0..3] of Char;
214 st
.ReadBuffer(sign
[0], 4);
215 st
.ReadBuffer(dofs
, 4); st
.ReadBuffer(fcnt
, 4);
216 st
.Seek(-12, soCurrent
);
217 if sign
<> 'RES0' then exit
;
218 if (dofs
< 0) or (dofs
> st
.Size
) or (fcnt
< 0) or
219 (dofs
+fcnt
> st
.Size
) then exit
;
225 procedure TSFSPlainVolume
.WADReadDirectory ();
230 name
: packed array [0..9] of Char;
232 fFileStream
.Seek(4, soCurrent
); // skip signature
233 fFileStream
.ReadBuffer(fcnt
, 4);
234 fFileStream
.ReadBuffer(dofs
, 4);
235 fFileStream
.Position
:= dofs
;
238 fi
:= TSFSFileInfo
.Create(self
);
239 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
240 fFileStream
.ReadBuffer(fi
.fSize
, 4);
241 FillChar(name
[0], Length(name
), 0);
242 fFileStream
.ReadBuffer(name
[0], 8);
243 fi
.fName
:= PChar(@name
[0]);
248 procedure TSFSPlainVolume
.PAKReadDirectory ();
250 dsize
, dofs
: LongWord;
252 name
: packed array [0..56] of Char;
254 fFileStream
.Seek(4, soCurrent
); // skip signature
255 fFileStream
.ReadBuffer(dofs
, 4);
256 fFileStream
.ReadBuffer(dsize
, 4);
257 fFileStream
.Position
:= dofs
;
260 fi
:= TSFSFileInfo
.Create(self
);
261 FillChar(name
[0], Length(name
), 0);
262 fFileStream
.ReadBuffer(name
[0], 56);
263 fi
.fName
:= PChar(@name
[0]);
264 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
265 fFileStream
.ReadBuffer(fi
.fSize
, 4);
270 procedure TSFSPlainVolume
.SINReadDirectory ();
272 dsize
, dofs
: LongWord;
274 name
: packed array [0..120] of Char;
276 fFileStream
.Seek(4, soCurrent
); // skip signature
277 fFileStream
.ReadBuffer(dofs
, 4);
278 fFileStream
.ReadBuffer(dsize
, 4);
279 fFileStream
.Position
:= dofs
;
280 while dsize
>= 128 do
282 fi
:= TSFSFileInfo
.Create(self
);
283 FillChar(name
[0], Length(name
), 0);
284 fFileStream
.ReadBuffer(name
[0], 120);
285 fi
.fName
:= PChar(@name
[0]);
286 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
287 fFileStream
.ReadBuffer(fi
.fSize
, 4);
292 procedure TSFSPlainVolume
.GRPReadDirectory ();
296 name
: packed array [0..12] of Char;
299 fFileStream
.Seek(12, soCurrent
); // skip signature
300 fFileStream
.ReadBuffer(fcnt
, 4);
301 ofs
:= fFileStream
.Position
+fcnt
*16;
304 fi
:= TSFSFileInfo
.Create(self
);
306 FillChar(name
[0], Length(name
), 0);
307 fFileStream
.ReadBuffer(name
[0], 12);
308 fi
.fName
:= PChar(@name
[0]);
309 fFileStream
.ReadBuffer(fi
.fSize
, 4);
315 procedure TSFSPlainVolume
.SPEReadDirectory ();
319 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
325 wasUnfixedLink
: Boolean;
327 fFileStream
.Seek(8, soCurrent
); // skip signature
328 fFileStream
.ReadBuffer(fcnt
, 2);
331 fi
:= TSFSExtFileInfo
.Create(self
);
332 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
333 SetLength(fi
.fVBuf
, 1); fFileStream
.ReadBuffer(fi
.fVBuf
[0], 1);
335 SetLength(fi
.fVBuf
, 0);
336 fFileStream
.ReadBuffer(b
, 1);
337 pp
:= IntToHex(b
, 2)+'/';
339 fFileStream
.ReadBuffer(name
[0], 1);
340 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
341 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
342 fi
.fName
:= SFSReplacePathDelims(name
, '/');
343 if fi
.fName
= '' then fi
.fName
:= 'untitled_file';
344 if fi
.fName
[1] = '/' then Delete(fi
.fName
, 1, 1);
345 {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
346 fi
.fName
:= pp
+fi
.fName
;
348 fFileStream
.ReadBuffer(b
, 1);
349 if (b
and $01) <> 0 then
352 fFileStream
.ReadBuffer(name
[0], 1);
353 if name
[0] <> #0 then fFileStream
.ReadBuffer(name
[1], Length(name
));
354 f
:= 1; while (f
<= ord(name
[0])) and (name
[f
] <> #0) do Inc(f
); name
[0] := chr(f
-1);
355 if name
[0] = #0 then name
:= #0;
361 fFileStream
.ReadBuffer(fi
.fSize
, 4);
362 {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
363 Inc(fi
.fSize
); // plus type byte
365 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
371 // nobody uses this shit, but it was documented by JC. %-)
372 // i even allow links to links! %-)
373 wasUnfixedLink
:= true;
374 while wasUnfixedLink
do
376 f
:= 0; wasUnfixedLink
:= false;
377 while f
< fFiles
.Count
do
379 fi
:= TSFSExtFileInfo(fFiles
[f
]); Inc(f
);
380 if (fi
= nil) or (fi
.fLink
= '') then continue
;
382 while c
< fFiles
.Count
do
386 // link can't be linked to itself
387 if SFSStrComp(TSFSExtFileInfo(fFiles
[c
]).fName
, fi
.fLink
) = 0 then break
;
391 if c
< fFiles
.Count
then
393 if TSFSExtFileInfo(fFiles
[c
]).fLink
<> '' then wasUnfixedLink
:= true
396 TSFSExtFileInfo(fFiles
[c
]).fOfs
:= fi
.fOfs
;
397 TSFSExtFileInfo(fFiles
[c
]).fSize
:= fi
.fSize
;
398 TSFSExtFileInfo(fFiles
[c
]).fLink
:= '';
401 else begin Dec(f
); fFiles
.Delete(f
); end; // invalid link
406 procedure TSFSPlainVolume
.WAD2ReadDirectory ();
408 fcnt
, dofs
: LongWord;
410 name
: packed array [0..16] of Char;
413 fFileStream
.Seek(4, soCurrent
); // skip signature
414 fFileStream
.ReadBuffer(fcnt
, 4);
415 fFileStream
.ReadBuffer(dofs
, 4);
416 fFileStream
.Position
:= dofs
;
419 fi
:= TSFSFileInfo
.Create(self
);
420 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
421 fFileStream
.ReadBuffer(fi
.fSize
, 4);
422 fFileStream
.ReadBuffer(f
, 4);
423 fFileStream
.ReadBuffer(c
, 4);
424 FillChar(name
[0], Length(name
), 0);
425 fFileStream
.ReadBuffer(name
[0], 16);
426 fi
.fName
:= PChar(@name
[0]);
431 procedure TSFSPlainVolume
.ALLReadDirectory ();
435 sign
: packed array [0..3] of Char;
436 nameList
: TStringList
;
437 propList
: TObjectList
;
440 prp
: TAllegroProperty
;
442 nameList
:= TStringList
.Create(); propList
:= nil;
444 propList
:= TObjectList
.Create(true);
445 fFileStream
.ReadBuffer(sign
[0], 4);
446 if sign
[0] = 's' then fFileStream
.ReadBuffer(sign
[0], 4);
448 fcnt
:= ReadMD(fFileStream
);
451 // collect properties
452 nameList
.Clear(); propList
.Clear();
454 fFileStream
.ReadBuffer(sign
[0], 4);
455 if sign
<> 'prop' then break
;
456 fFileStream
.ReadBuffer(sign
[0], 4);
457 f
:= ReadMD(fFileStream
); // size
460 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
461 WriteLn(ErrOutput
, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream
.Position
-8, 8));
463 raise ESFSError
.Create('invalid ALLEGRO file');
465 if sign
= 'NAME' then
467 if f
> 255 then c
:= 255 else c
:= f
;
468 FillChar(name
, SizeOf(name
), 0);
469 fFileStream
.ReadBuffer(name
[1], c
); name
[0] := chr(c
);
471 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
476 prp
:= TAllegroProperty
.Create();
477 Move(sign
[0], name
[1], 4); name
[0] := #4;
478 c
:= 1; while (c
<= ord(name
[0])) and (name
[c
] <> #0) do Inc(c
); name
[0] := chr(c
-1);
480 prp
.ofs
:= fFileStream
.Position
;
484 fFileStream
.Seek(f
, soCurrent
);
486 if nameList
.Count
= 0 then nameList
.Add('untitled_file');
488 Move(sign
[0], name
[1], 4); name
[5] := #0;
489 f
:= 1; while (f
<= 4) and (name
[f
] <> #0) do Inc(f
);
490 while (f
> 0) and (name
[f
] <= ' ') do Dec(f
);
494 f
:= ReadMD(fFileStream
);
495 c
:= ReadMD(fFileStream
);
498 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
499 WriteLn(ErrOutput
, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream
.Position
-8, 8));
501 raise ESFSError
.Create('invalid ALLEGRO file');
505 while nameList
.Count
> 0 do
507 fi
:= TSFSFileInfo
.Create(self
);
508 fi
.fName
:= nameList
[0];
511 fi
.fOfs
:= fFileStream
.Position
;
513 for f
:= 0 to propList
.Count
-1 do
515 prp
:= TAllegroProperty(propList
[f
]);
516 fi
:= TSFSFileInfo
.Create(self
);
517 fi
.fName
:= prp
.name
;
518 fi
.fPath
:= name
+'.props/'+nameList
[0];
519 fi
.fSize
:= prp
.size
;
524 fFileStream
.Seek(c
, soCurrent
);
527 {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
528 WriteLn(ErrOutput
, 'ALLEGRO: ok');
536 procedure TSFSPlainVolume
.Dune2ReadDirectory ();
544 fFileStream
.ReadBuffer(ofs
, 4);
545 if ofs
= 0 then break
;
547 fFileStream
.ReadBuffer(ch
, 1);
550 if name
[0] <> #255 then
552 Inc(name
[0]); name
[ord(name
[0])] := ch
;
554 fFileStream
.ReadBuffer(ch
, 1);
556 if fFiles
.Count
> 0 then
558 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
559 fi
.fSize
:= ofs
-fi
.fOfs
;
561 fi
:= TSFSFileInfo
.Create(self
);
566 if fFiles
.Count
> 0 then
568 fi
:= TSFSFileInfo(fFiles
[fFiles
.Count
-1]);
569 fi
.fSize
:= fFileStream
.Size
-fi
.fOfs
;
573 procedure TSFSPlainVolume
.MAXReadDirectory ();
578 name
: packed array [0..9] of Char;
580 fFileStream
.Seek(4, soCurrent
); // skip signature
581 fFileStream
.ReadBuffer(dofs
, 4);
582 fFileStream
.ReadBuffer(fcnt
, 4);
583 fFileStream
.Position
:= dofs
;
586 fi
:= TSFSFileInfo
.Create(self
);
587 FillChar(name
[0], Length(name
), 0);
588 fFileStream
.ReadBuffer(name
[0], 8);
589 fFileStream
.ReadBuffer(fi
.fOfs
, 4);
590 fFileStream
.ReadBuffer(fi
.fSize
, 4);
591 fi
.fName
:= PChar(@name
[0]);
597 procedure TSFSPlainVolume
.ReadDirectory ();
600 sfspvWAD
: WADReadDirectory();
601 sfspvPAK
: PAKReadDirectory();
602 sfspvGRP
: GRPReadDirectory();
603 sfspvSPE
: SPEReadDirectory();
604 sfspvWAD2
: WAD2ReadDirectory();
605 sfspvALL
: ALLReadDirectory();
606 sfspvDune2
: Dune2ReadDirectory();
607 sfspvMAX
: MAXReadDirectory();
608 sfspvSIN
: SINReadDirectory();
609 else raise ESFSError
.Create('invalid plain SFS');
613 function TSFSPlainVolume
.OpenFileByIndex (const index
: Integer): TStream
;
618 result
:= nil; fs
:= nil;
619 if fFiles
= nil then exit
;
620 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
621 if not (fFiles
[index
] is TSFSExtFileInfo
) or
622 (Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
) < 1) then
627 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
632 result
:= TSFSPartialStream
.Create(fs
,
633 TSFSFileInfo(fFiles
[index
]).fOfs
,
634 TSFSFileInfo(fFiles
[index
]).fSize
, kill
);
636 if kill
then FreeAndNil(fs
);
645 fs
:= TFileStream
.Create(fFileName
, fmOpenRead
or fmShareDenyWrite
);
650 result
:= TSFSPartialStream
.Create(fs
,
651 TSFSExtFileInfo(fFiles
[index
]).fOfs
,
652 TSFSExtFileInfo(fFiles
[index
]).fSize
-Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
),
654 @(TSFSExtFileInfo(fFiles
[index
]).fVBuf
[0]),
655 Length(TSFSExtFileInfo(fFiles
[index
]).fVBuf
));
657 if kill
then FreeAndNil(fs
);
664 { TSFSPlainVolumeFactory }
665 function TSFSPlainVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
668 (SFSStrComp(prefix
, 'pak') = 0) or
669 //(SFSStrComp(prefix, 'wad') = 0) or // sorry
670 (SFSStrComp(prefix
, 'wad2') = 0) or
671 (SFSStrComp(prefix
, 'grp') = 0) or
672 (SFSStrComp(prefix
, 'spe') = 0) or
673 (SFSStrComp(prefix
, 'spec') = 0) or
674 (SFSStrComp(prefix
, 'quake') = 0) or
675 (SFSStrComp(prefix
, 'doom') = 0) or
676 (SFSStrComp(prefix
, 'duke3d') = 0) or
677 (SFSStrComp(prefix
, 'abuse') = 0) or
678 (SFSStrComp(prefix
, 'allegro') = 0) or
679 (SFSStrComp(prefix
, 'dune2') = 0) or
680 (SFSStrComp(prefix
, 'max') = 0) or
681 (SFSStrComp(prefix
, 'sin') = 0);
684 procedure TSFSPlainVolumeFactory
.Recycle (vol
: TSFSVolume
);
689 function TSFSPlainVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
691 vt
: TSFSPlainVolumeType
;
694 if WADCheckMagic(st
) then vt
:= sfspvWAD
695 else if PAKCheckMagic(st
) then vt
:= sfspvPAK
696 else if GRPCheckMagic(st
) then vt
:= sfspvGRP
697 else if SPECheckMagic(st
) then vt
:= sfspvSPE
698 else if WAD2CheckMagic(st
) then vt
:= sfspvWAD2
699 //else if ALLCheckMagic(st) then vt := sfspvALL
700 else if MAXCheckMagic(st
) then vt
:= sfspvMAX
701 else if SINCheckMagic(st
) then vt
:= sfspvSIN
;
702 //else if Dune2CheckMagic(st) then vt := sfspvDune2; // this must be the last!
704 if vt
<> sfspvNone
then
706 result
:= TSFSPlainVolume
.Create(fileName
, st
);
707 TSFSPlainVolume(result
).fType
:= vt
;
709 result
.DoDirectoryRead();
720 pakf
: TSFSPlainVolumeFactory
;
722 pakf
:= TSFSPlainVolumeFactory
.Create();
723 SFSRegisterVolumeFactory(pakf
);
725 SFSUnregisterVolumeFactory(pakf
);