src/sfs/sfsPlainFS.pas

   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.
   4 //
   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 %-(
  13 //   M.A.X. res      : RES0
  14 //   sin             : SiN .SIN (SPAK)
  15 //
  16 {.$DEFINE SFS_PLAIN_FS_ALTERNATIVE_SPEC}
  17   // define this and the first byte of each file in .SPE will contain
  18   // file type.
  19   // undefine this and file type will be directory name.
  20 {.$DEFINE SFS_PLAIN_FS_DEBUG_ALLEGRO}
  21 {$MODE DELPHI}
  22 {.$R-}
  23 unit sfsPlainFS;
  24
  25 interface
  26
  27 uses
  28   SysUtils, Classes, Contnrs, sfs;
  29
  30
  31
  32 type
  33   TSFSPlainVolumeType =
  34     (sfspvNone, sfspvWAD, sfspvPAK, sfspvGRP, sfspvSPE, sfspvWAD2, sfspvALL,
  35      sfspvDune2, sfspvMAX, sfspvSIN);
  36
  37   TSFSPlainVolume = class (TSFSVolume)
  38   protected
  39     fType: TSFSPlainVolumeType;
  40
  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 ();
  50
  51     procedure ReadDirectory (); override;
  52     function OpenFileByIndex (const index: Integer): TStream; override;
  53   end;
  54
  55   TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
  56   public
  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;
  60   end;
  61
  62
  63
  64 implementation
  65
  66 uses
  67   xstreams;
  68
  69
  70 type
  71   TSFSExtFileInfo = class (TSFSFileInfo)
  72   public
  73     fVBuf: packed array of Byte;
  74     fLink: TSFSString;
  75   end;
  76
  77   TAllegroProperty = class
  78     name: TSFSString;
  79     ofs: Int64;
  80     size: Integer;
  81   end;
  82
  83
  84 function ReadMD (st: TStream): Integer;
  85 // read dword in big-endian format. portable.
  86 var
  87   buf: packed array [0..3] of Byte;
  88 begin
  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];
  91 end;
  92
  93 function WADCheckMagic (st: TStream): Boolean;
  94 var
  95   sign: packed array [0..3] of Char;
  96   fcnt, dofs: Integer;
  97 begin
  98   result := false;
  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;
 105   result := true;
 106 end;
 107
 108 function PAKCheckMagic (st: TStream): Boolean;
 109 var
 110   sign: packed array [0..3] of Char;
 111   dsize, dofs: Integer;
 112 begin
 113   result := false;
 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;
 120   result := true;
 121 end;
 122
 123 function SINCheckMagic (st: TStream): Boolean;
 124 var
 125   sign: packed array [0..3] of Char;
 126   dsize, dofs: Integer;
 127 begin
 128   result := false;
 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;
 135   result := true;
 136 end;
 137
 138 function GRPCheckMagic (st: TStream): Boolean;
 139 var
 140   sign: packed array [0..11] of Char;
 141   fcnt: Integer;
 142 begin
 143   result := false;
 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;
 149   result := true;
 150 end;
 151
 152 function SPECheckMagic (st: TStream): Boolean;
 153 var
 154   sign: packed array [0..6] of Char;
 155   b: Byte;
 156   fcnt: Integer;
 157 begin
 158   result := false;
 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;
 163   result := true;
 164 end;
 165
 166 function WAD2CheckMagic (st: TStream): Boolean;
 167 var
 168   sign: packed array [0..3] of Char;
 169   fcnt, dofs: Integer;
 170 begin
 171   result := false;
 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;
 178   result := true;
 179 end;
 180
 181 function ALLCheckMagic (st: TStream): Boolean;
 182 var
 183   sign0, sign1: packed array [0..3] of Char;
 184 begin
 185   result := false;
 186   st.ReadBuffer(sign0[0], 4);
 187   st.ReadBuffer(sign1[0], 4);
 188   st.Seek(-8, soCurrent);
 189   if sign0 = 'slh.' then
 190   begin
 191     if sign1 <> 'ALL.' then exit;
 192   end else if sign0 <> 'ALL.' then exit;
 193   result := true;
 194 end;
 195
 196 function Dune2CheckMagic (st: TStream): Boolean;
 197 var
 198   cpos, np, f: Integer;
 199 begin
 200   cpos := st.Position;
 201   st.ReadBuffer(np, 4);
 202   st.Position := np-4;
 203   st.ReadBuffer(f, 4);
 204   st.Position := cpos;
 205   result := (f = 0);
 206 end;
 207
 208 function MAXCheckMagic (st: TStream): Boolean;
 209 var
 210   sign: packed array [0..3] of Char;
 211   fcnt, dofs: Integer;
 212 begin
 213   result := false;
 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;
 220   result := true;
 221 end;
 222
 223
 224 { TSFSPlainVolume }
 225 procedure TSFSPlainVolume.WADReadDirectory ();
 226 var
 227   fcnt: LongWord;
 228   dofs: LongWord;
 229   fi: TSFSFileInfo;
 230   name: packed array [0..9] of Char;
 231 begin
 232   fFileStream.Seek(4, soCurrent); // skip signature
 233   fFileStream.ReadBuffer(fcnt, 4);
 234   fFileStream.ReadBuffer(dofs, 4);
 235   fFileStream.Position := dofs;
 236   while fcnt <> 0 do
 237   begin
 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]);
 244     Dec(fcnt);
 245   end;
 246 end;
 247
 248 procedure TSFSPlainVolume.PAKReadDirectory ();
 249 var
 250   dsize, dofs: LongWord;
 251   fi: TSFSFileInfo;
 252   name: packed array [0..56] of Char;
 253 begin
 254   fFileStream.Seek(4, soCurrent); // skip signature
 255   fFileStream.ReadBuffer(dofs, 4);
 256   fFileStream.ReadBuffer(dsize, 4);
 257   fFileStream.Position := dofs;
 258   while dsize >= 64 do
 259   begin
 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);
 266     Dec(dsize, 64);
 267   end;
 268 end;
 269
 270 procedure TSFSPlainVolume.SINReadDirectory ();
 271 var
 272   dsize, dofs: LongWord;
 273   fi: TSFSFileInfo;
 274   name: packed array [0..120] of Char;
 275 begin
 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
 281   begin
 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);
 288     Dec(dsize, 128);
 289   end;
 290 end;
 291
 292 procedure TSFSPlainVolume.GRPReadDirectory ();
 293 var
 294   fcnt: LongWord;
 295   fi: TSFSFileInfo;
 296   name: packed array [0..12] of Char;
 297   ofs: Int64;
 298 begin
 299   fFileStream.Seek(12, soCurrent); // skip signature
 300   fFileStream.ReadBuffer(fcnt, 4);
 301   ofs := fFileStream.Position+fcnt*16;
 302   while fcnt <> 0 do
 303   begin
 304     fi := TSFSFileInfo.Create(self);
 305     fi.fOfs := ofs;
 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);
 310     Inc(ofs, fi.fSize);
 311     Dec(fcnt);
 312   end;
 313 end;
 314
 315 procedure TSFSPlainVolume.SPEReadDirectory ();
 316 var
 317   fcnt: Word;
 318   fi: TSFSExtFileInfo;
 319   {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 320   pp: TSFSString;
 321   {$ENDIF}
 322   name: ShortString;
 323   f, c: Integer;
 324   b: Byte;
 325   wasUnfixedLink: Boolean;
 326 begin
 327   fFileStream.Seek(8, soCurrent); // skip signature
 328   fFileStream.ReadBuffer(fcnt, 2);
 329   while fcnt <> 0 do
 330   begin
 331     fi := TSFSExtFileInfo.Create(self);
 332    {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 333     SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1);
 334    {$ELSE}
 335      SetLength(fi.fVBuf, 0);
 336     fFileStream.ReadBuffer(b, 1);
 337     pp := IntToHex(b, 2)+'/';
 338    {$ENDIF}
 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;
 347    {$ENDIF}
 348     fFileStream.ReadBuffer(b, 1);
 349     if (b and $01) <> 0 then
 350     begin
 351       // link
 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;
 356       fi.fLink := name;
 357     end
 358     else
 359     begin
 360       fi.fLink := '';
 361       fFileStream.ReadBuffer(fi.fSize, 4);
 362      {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 363       Inc(fi.fSize); // plus type byte
 364      {$ENDIF}
 365       fFileStream.ReadBuffer(fi.fOfs, 4);
 366     end;
 367     Dec(fcnt);
 368   end;
 369
 370   // now fixup links
 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
 375   begin
 376     f := 0; wasUnfixedLink := false;
 377     while f < fFiles.Count do
 378     begin
 379       fi := TSFSExtFileInfo(fFiles[f]); Inc(f);
 380       if (fi = nil) or (fi.fLink = '') then continue;
 381       c := 0;
 382       while c < fFiles.Count do
 383       begin
 384         if c <> f then
 385         begin
 386           // link can't be linked to itself
 387           if SFSStrComp(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) = 0 then break;
 388         end;
 389         Inc(c);
 390       end;
 391       if c < fFiles.Count then
 392       begin
 393         if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true
 394         else
 395         begin
 396           TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs;
 397           TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize;
 398           TSFSExtFileInfo(fFiles[c]).fLink := '';
 399         end;
 400       end
 401       else begin Dec(f); fFiles.Delete(f); end; // invalid link
 402     end;
 403   end;
 404 end;
 405
 406 procedure TSFSPlainVolume.WAD2ReadDirectory ();
 407 var
 408   fcnt, dofs: LongWord;
 409   fi: TSFSFileInfo;
 410   name: packed array [0..16] of Char;
 411   f, c: Integer;
 412 begin
 413   fFileStream.Seek(4, soCurrent); // skip signature
 414   fFileStream.ReadBuffer(fcnt, 4);
 415   fFileStream.ReadBuffer(dofs, 4);
 416   fFileStream.Position := dofs;
 417   while fcnt <> 0 do
 418   begin
 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]);
 427     Dec(fcnt);
 428   end;
 429 end;
 430
 431 procedure TSFSPlainVolume.ALLReadDirectory ();
 432 var
 433   fcnt: Integer;
 434   fi: TSFSFileInfo;
 435   sign: packed array [0..3] of Char;
 436   nameList: TStringList;
 437   propList: TObjectList;
 438   name: ShortString;
 439   f, c: Integer;
 440   prp: TAllegroProperty;
 441 begin
 442   nameList := TStringList.Create(); propList := nil;
 443   try
 444     propList := TObjectList.Create(true);
 445     fFileStream.ReadBuffer(sign[0], 4);
 446     if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4);
 447     // signature skipped
 448     fcnt := ReadMD(fFileStream);
 449     while fcnt > 0 do
 450     begin
 451       // collect properties
 452       nameList.Clear(); propList.Clear();
 453       repeat
 454         fFileStream.ReadBuffer(sign[0], 4);
 455         if sign <> 'prop' then break;
 456         fFileStream.ReadBuffer(sign[0], 4);
 457         f := ReadMD(fFileStream); // size
 458         if f < 0 then
 459         begin
 460          {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 461           WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8));
 462          {$ENDIF}
 463           raise ESFSError.Create('invalid ALLEGRO file');
 464         end;
 465         if sign = 'NAME' then
 466         begin
 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);
 470           Dec(f, c);
 471           c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
 472           nameList.Add(name);
 473         end
 474         else
 475         begin
 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);
 479           prp.name := sign;
 480           prp.ofs := fFileStream.Position;
 481           prp.size := f;
 482           propList.Add(prp);
 483         end;
 484         fFileStream.Seek(f, soCurrent);
 485       until false;
 486       if nameList.Count = 0 then nameList.Add('untitled_file');
 487
 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);
 491       name[0] := chr(f);
 492
 493       // read size
 494       f := ReadMD(fFileStream);
 495       c := ReadMD(fFileStream);
 496       if f <> c then
 497       begin
 498        {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 499         WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8));
 500        {$ENDIF}
 501         raise ESFSError.Create('invalid ALLEGRO file');
 502       end;
 503
 504       // add files
 505       while nameList.Count > 0 do
 506       begin
 507         fi := TSFSFileInfo.Create(self);
 508         fi.fName := nameList[0];
 509         fi.fPath := name;
 510         fi.fSize := c;
 511         fi.fOfs := fFileStream.Position;
 512         // add properties
 513         for f := 0 to propList.Count-1 do
 514         begin
 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;
 520           fi.fOfs := prp.ofs;
 521         end;
 522         nameList.Delete(0);
 523       end;
 524       fFileStream.Seek(c, soCurrent);
 525       Dec(fcnt);
 526     end;
 527    {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 528     WriteLn(ErrOutput, 'ALLEGRO: ok');
 529    {$ENDIF}
 530   finally
 531     propList.Free();
 532     nameList.Free();
 533   end;
 534 end;
 535
 536 procedure TSFSPlainVolume.Dune2ReadDirectory ();
 537 var
 538   ofs: LongWord;
 539   fi: TSFSFileInfo;
 540   name: string[255];
 541   ch: Char;
 542 begin
 543   repeat
 544     fFileStream.ReadBuffer(ofs, 4);
 545     if ofs = 0 then break;
 546     name[0] := #0;
 547     fFileStream.ReadBuffer(ch, 1);
 548     while ch <> #0 do
 549     begin
 550       if name[0] <> #255 then
 551       begin
 552         Inc(name[0]); name[ord(name[0])] := ch;
 553       end;
 554       fFileStream.ReadBuffer(ch, 1);
 555     end;
 556     if fFiles.Count > 0 then
 557     begin
 558       fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 559       fi.fSize := ofs-fi.fOfs;
 560     end;
 561     fi := TSFSFileInfo.Create(self);
 562     fi.fOfs := ofs;
 563     fi.fSize := 0;
 564     fi.fName := name;
 565   until false;
 566   if fFiles.Count > 0 then
 567   begin
 568     fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 569     fi.fSize := fFileStream.Size-fi.fOfs;
 570   end;
 571 end;
 572
 573 procedure TSFSPlainVolume.MAXReadDirectory ();
 574 var
 575   fcnt: LongInt;
 576   dofs: LongWord;
 577   fi: TSFSFileInfo;
 578   name: packed array [0..9] of Char;
 579 begin
 580   fFileStream.Seek(4, soCurrent); // skip signature
 581   fFileStream.ReadBuffer(dofs, 4);
 582   fFileStream.ReadBuffer(fcnt, 4);
 583   fFileStream.Position := dofs;
 584   while fcnt >= 16 do
 585   begin
 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]);
 592     Dec(fcnt, 16);
 593   end;
 594 end;
 595
 596
 597 procedure TSFSPlainVolume.ReadDirectory ();
 598 begin
 599   case fType of
 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');
 610   end;
 611 end;
 612
 613 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
 614 var
 615   fs: TStream;
 616   kill: Boolean;
 617 begin
 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
 623   begin
 624     kill := false;
 625     try
 626       try
 627         fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
 628         kill := true;
 629       except
 630         fs := fFileStream;
 631       end;
 632       result := TSFSPartialStream.Create(fs,
 633         TSFSFileInfo(fFiles[index]).fOfs,
 634         TSFSFileInfo(fFiles[index]).fSize, kill);
 635     except
 636       if kill then FreeAndNil(fs);
 637       result := nil;
 638     end;
 639   end
 640   else
 641   begin
 642     kill := false;
 643     try
 644       try
 645         fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
 646         kill := true;
 647       except
 648         fs := fFileStream;
 649       end;
 650       result := TSFSPartialStream.Create(fs,
 651         TSFSExtFileInfo(fFiles[index]).fOfs,
 652         TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf),
 653         kill,
 654         @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]),
 655         Length(TSFSExtFileInfo(fFiles[index]).fVBuf));
 656     except
 657       if kill then FreeAndNil(fs);
 658       result := nil;
 659     end;
 660   end;
 661 end;
 662
 663
 664 { TSFSPlainVolumeFactory }
 665 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
 666 begin
 667   result :=
 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);
 682 end;
 683
 684 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
 685 begin
 686   vol.Free();
 687 end;
 688
 689 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
 690 var
 691   vt: TSFSPlainVolumeType;
 692 begin
 693   vt := sfspvNone;
 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!
 703
 704   if vt <> sfspvNone then
 705   begin
 706     result := TSFSPlainVolume.Create(fileName, st);
 707     TSFSPlainVolume(result).fType := vt;
 708     try
 709       result.DoDirectoryRead();
 710     except
 711       FreeAndNil(result);
 712       raise;
 713     end;
 714   end
 715   else result := nil;
 716 end;
 717
 718
 719 var
 720   pakf: TSFSPlainVolumeFactory;
 721 initialization
 722   pakf := TSFSPlainVolumeFactory.Create();
 723   SFSRegisterVolumeFactory(pakf);
 724 finalization
 725   SFSUnregisterVolumeFactory(pakf);
 726 end.