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
  53   public
  54     function OpenFileByIndex (const index: Integer): TStream; override;
  55   end;
  56
  57   TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
  58   public
  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;
  62   end;
  63
  64
  65
  66 implementation
  67
  68 uses
  69   xstreams;
  70
  71
  72 type
  73   TSFSExtFileInfo = class (TSFSFileInfo)
  74   public
  75     fVBuf: packed array of Byte;
  76     fLink: TSFSString;
  77   end;
  78
  79   TAllegroProperty = class
  80     name: TSFSString;
  81     ofs: Int64;
  82     size: Integer;
  83   end;
  84
  85
  86 function ReadMD (st: TStream): Integer;
  87 // read dword in big-endian format. portable.
  88 var
  89   buf: packed array [0..3] of Byte;
  90 begin
  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];
  93 end;
  94
  95 function WADCheckMagic (st: TStream): Boolean;
  96 var
  97   sign: packed array [0..3] of Char;
  98   fcnt, dofs: Integer;
  99 begin
 100   result := false;
 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;
 107   result := true;
 108 end;
 109
 110 function PAKCheckMagic (st: TStream): Boolean;
 111 var
 112   sign: packed array [0..3] of Char;
 113   dsize, dofs: Integer;
 114 begin
 115   result := false;
 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;
 122   result := true;
 123 end;
 124
 125 function SINCheckMagic (st: TStream): Boolean;
 126 var
 127   sign: packed array [0..3] of Char;
 128   dsize, dofs: Integer;
 129 begin
 130   result := false;
 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;
 137   result := true;
 138 end;
 139
 140 function GRPCheckMagic (st: TStream): Boolean;
 141 var
 142   sign: packed array [0..11] of Char;
 143   fcnt: Integer;
 144 begin
 145   result := false;
 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;
 151   result := true;
 152 end;
 153
 154 function SPECheckMagic (st: TStream): Boolean;
 155 var
 156   sign: packed array [0..6] of Char;
 157   b: Byte;
 158   fcnt: Integer;
 159 begin
 160   result := false;
 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;
 165   result := true;
 166 end;
 167
 168 function WAD2CheckMagic (st: TStream): Boolean;
 169 var
 170   sign: packed array [0..3] of Char;
 171   fcnt, dofs: Integer;
 172 begin
 173   result := false;
 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;
 180   result := true;
 181 end;
 182
 183 function ALLCheckMagic (st: TStream): Boolean;
 184 var
 185   sign0, sign1: packed array [0..3] of Char;
 186 begin
 187   result := false;
 188   st.ReadBuffer(sign0[0], 4);
 189   st.ReadBuffer(sign1[0], 4);
 190   st.Seek(-8, soCurrent);
 191   if sign0 = 'slh.' then
 192   begin
 193     if sign1 <> 'ALL.' then exit;
 194   end else if sign0 <> 'ALL.' then exit;
 195   result := true;
 196 end;
 197
 198 function Dune2CheckMagic (st: TStream): Boolean;
 199 var
 200   cpos, np, f: Integer;
 201 begin
 202   cpos := st.Position;
 203   st.ReadBuffer(np, 4);
 204   st.Position := np-4;
 205   st.ReadBuffer(f, 4);
 206   st.Position := cpos;
 207   result := (f = 0);
 208 end;
 209
 210 function MAXCheckMagic (st: TStream): Boolean;
 211 var
 212   sign: packed array [0..3] of Char;
 213   fcnt, dofs: Integer;
 214 begin
 215   result := false;
 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;
 222   result := true;
 223 end;
 224
 225
 226 { TSFSPlainVolume }
 227 procedure TSFSPlainVolume.WADReadDirectory ();
 228 var
 229   fcnt: LongWord;
 230   dofs: LongWord;
 231   fi: TSFSFileInfo;
 232   name: packed array [0..9] of Char;
 233 begin
 234   fFileStream.Seek(4, soCurrent); // skip signature
 235   fFileStream.ReadBuffer(fcnt, 4);
 236   fFileStream.ReadBuffer(dofs, 4);
 237   fFileStream.Position := dofs;
 238   while fcnt <> 0 do
 239   begin
 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]);
 246     Dec(fcnt);
 247   end;
 248 end;
 249
 250 procedure TSFSPlainVolume.PAKReadDirectory ();
 251 var
 252   dsize, dofs: LongWord;
 253   fi: TSFSFileInfo;
 254   name: packed array [0..56] of Char;
 255 begin
 256   fFileStream.Seek(4, soCurrent); // skip signature
 257   fFileStream.ReadBuffer(dofs, 4);
 258   fFileStream.ReadBuffer(dsize, 4);
 259   fFileStream.Position := dofs;
 260   while dsize >= 64 do
 261   begin
 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);
 268     Dec(dsize, 64);
 269   end;
 270 end;
 271
 272 procedure TSFSPlainVolume.SINReadDirectory ();
 273 var
 274   dsize, dofs: LongWord;
 275   fi: TSFSFileInfo;
 276   name: packed array [0..120] of Char;
 277 begin
 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
 283   begin
 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);
 290     Dec(dsize, 128);
 291   end;
 292 end;
 293
 294 procedure TSFSPlainVolume.GRPReadDirectory ();
 295 var
 296   fcnt: LongWord;
 297   fi: TSFSFileInfo;
 298   name: packed array [0..12] of Char;
 299   ofs: Int64;
 300 begin
 301   fFileStream.Seek(12, soCurrent); // skip signature
 302   fFileStream.ReadBuffer(fcnt, 4);
 303   ofs := fFileStream.Position+fcnt*16;
 304   while fcnt <> 0 do
 305   begin
 306     fi := TSFSFileInfo.Create(self);
 307     fi.fOfs := ofs;
 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);
 312     Inc(ofs, fi.fSize);
 313     Dec(fcnt);
 314   end;
 315 end;
 316
 317 procedure TSFSPlainVolume.SPEReadDirectory ();
 318 var
 319   fcnt: Word;
 320   fi: TSFSExtFileInfo;
 321   {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 322   pp: TSFSString;
 323   {$ENDIF}
 324   name: ShortString;
 325   f, c: Integer;
 326   b: Byte;
 327   wasUnfixedLink: Boolean;
 328 begin
 329   fFileStream.Seek(8, soCurrent); // skip signature
 330   fFileStream.ReadBuffer(fcnt, 2);
 331   while fcnt <> 0 do
 332   begin
 333     fi := TSFSExtFileInfo.Create(self);
 334    {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 335     SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1);
 336    {$ELSE}
 337      SetLength(fi.fVBuf, 0);
 338     fFileStream.ReadBuffer(b, 1);
 339     pp := IntToHex(b, 2)+'/';
 340    {$ENDIF}
 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;
 349    {$ENDIF}
 350     fFileStream.ReadBuffer(b, 1);
 351     if (b and $01) <> 0 then
 352     begin
 353       // link
 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;
 358       fi.fLink := name;
 359     end
 360     else
 361     begin
 362       fi.fLink := '';
 363       fFileStream.ReadBuffer(fi.fSize, 4);
 364      {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 365       Inc(fi.fSize); // plus type byte
 366      {$ENDIF}
 367       fFileStream.ReadBuffer(fi.fOfs, 4);
 368     end;
 369     Dec(fcnt);
 370   end;
 371
 372   // now fixup links
 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
 377   begin
 378     f := 0; wasUnfixedLink := false;
 379     while f < fFiles.Count do
 380     begin
 381       fi := TSFSExtFileInfo(fFiles[f]); Inc(f);
 382       if (fi = nil) or (fi.fLink = '') then continue;
 383       c := 0;
 384       while c < fFiles.Count do
 385       begin
 386         if c <> f then
 387         begin
 388           // link can't be linked to itself
 389           if SFSStrEqu(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) then break;
 390         end;
 391         Inc(c);
 392       end;
 393       if c < fFiles.Count then
 394       begin
 395         if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true
 396         else
 397         begin
 398           TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs;
 399           TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize;
 400           TSFSExtFileInfo(fFiles[c]).fLink := '';
 401         end;
 402       end
 403       else begin Dec(f); fFiles.Delete(f); end; // invalid link
 404     end;
 405   end;
 406 end;
 407
 408 procedure TSFSPlainVolume.WAD2ReadDirectory ();
 409 var
 410   fcnt, dofs: LongWord;
 411   fi: TSFSFileInfo;
 412   name: packed array [0..16] of Char;
 413   f, c: Integer;
 414 begin
 415   fFileStream.Seek(4, soCurrent); // skip signature
 416   fFileStream.ReadBuffer(fcnt, 4);
 417   fFileStream.ReadBuffer(dofs, 4);
 418   fFileStream.Position := dofs;
 419   while fcnt <> 0 do
 420   begin
 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]);
 429     Dec(fcnt);
 430   end;
 431 end;
 432
 433 procedure TSFSPlainVolume.ALLReadDirectory ();
 434 var
 435   fcnt: Integer;
 436   fi: TSFSFileInfo;
 437   sign: packed array [0..3] of Char;
 438   nameList: TStringList;
 439   propList: TObjectList;
 440   name: ShortString;
 441   f, c: Integer;
 442   prp: TAllegroProperty;
 443 begin
 444   nameList := TStringList.Create(); propList := nil;
 445   try
 446     propList := TObjectList.Create(true);
 447     fFileStream.ReadBuffer(sign[0], 4);
 448     if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4);
 449     // signature skipped
 450     fcnt := ReadMD(fFileStream);
 451     while fcnt > 0 do
 452     begin
 453       // collect properties
 454       nameList.Clear(); propList.Clear();
 455       repeat
 456         fFileStream.ReadBuffer(sign[0], 4);
 457         if sign <> 'prop' then break;
 458         fFileStream.ReadBuffer(sign[0], 4);
 459         f := ReadMD(fFileStream); // size
 460         if f < 0 then
 461         begin
 462          {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 463           WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8));
 464          {$ENDIF}
 465           raise ESFSError.Create('invalid ALLEGRO file');
 466         end;
 467         if sign = 'NAME' then
 468         begin
 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);
 472           Dec(f, c);
 473           c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
 474           nameList.Add(name);
 475         end
 476         else
 477         begin
 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);
 481           prp.name := sign;
 482           prp.ofs := fFileStream.Position;
 483           prp.size := f;
 484           propList.Add(prp);
 485         end;
 486         fFileStream.Seek(f, soCurrent);
 487       until false;
 488       if nameList.Count = 0 then nameList.Add('untitled_file');
 489
 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);
 493       name[0] := chr(f);
 494
 495       // read size
 496       f := ReadMD(fFileStream);
 497       c := ReadMD(fFileStream);
 498       if f <> c then
 499       begin
 500        {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 501         WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8));
 502        {$ENDIF}
 503         raise ESFSError.Create('invalid ALLEGRO file');
 504       end;
 505
 506       // add files
 507       while nameList.Count > 0 do
 508       begin
 509         fi := TSFSFileInfo.Create(self);
 510         fi.fName := nameList[0];
 511         fi.fPath := name;
 512         fi.fSize := c;
 513         fi.fOfs := fFileStream.Position;
 514         // add properties
 515         for f := 0 to propList.Count-1 do
 516         begin
 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;
 522           fi.fOfs := prp.ofs;
 523         end;
 524         nameList.Delete(0);
 525       end;
 526       fFileStream.Seek(c, soCurrent);
 527       Dec(fcnt);
 528     end;
 529    {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 530     WriteLn(ErrOutput, 'ALLEGRO: ok');
 531    {$ENDIF}
 532   finally
 533     propList.Free();
 534     nameList.Free();
 535   end;
 536 end;
 537
 538 procedure TSFSPlainVolume.Dune2ReadDirectory ();
 539 var
 540   ofs: LongWord;
 541   fi: TSFSFileInfo;
 542   name: string[255];
 543   ch: Char;
 544 begin
 545   repeat
 546     fFileStream.ReadBuffer(ofs, 4);
 547     if ofs = 0 then break;
 548     name[0] := #0;
 549     fFileStream.ReadBuffer(ch, 1);
 550     while ch <> #0 do
 551     begin
 552       if name[0] <> #255 then
 553       begin
 554         Inc(name[0]); name[ord(name[0])] := ch;
 555       end;
 556       fFileStream.ReadBuffer(ch, 1);
 557     end;
 558     if fFiles.Count > 0 then
 559     begin
 560       fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 561       fi.fSize := ofs-fi.fOfs;
 562     end;
 563     fi := TSFSFileInfo.Create(self);
 564     fi.fOfs := ofs;
 565     fi.fSize := 0;
 566     fi.fName := name;
 567   until false;
 568   if fFiles.Count > 0 then
 569   begin
 570     fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 571     fi.fSize := fFileStream.Size-fi.fOfs;
 572   end;
 573 end;
 574
 575 procedure TSFSPlainVolume.MAXReadDirectory ();
 576 var
 577   fcnt: LongInt;
 578   dofs: LongWord;
 579   fi: TSFSFileInfo;
 580   name: packed array [0..9] of Char;
 581 begin
 582   fFileStream.Seek(4, soCurrent); // skip signature
 583   fFileStream.ReadBuffer(dofs, 4);
 584   fFileStream.ReadBuffer(fcnt, 4);
 585   fFileStream.Position := dofs;
 586   while fcnt >= 16 do
 587   begin
 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]);
 594     Dec(fcnt, 16);
 595   end;
 596 end;
 597
 598
 599 procedure TSFSPlainVolume.ReadDirectory ();
 600 begin
 601   case fType of
 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');
 612   end;
 613 end;
 614
 615 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
 616 var
 617   fs: TStream;
 618   kill: Boolean;
 619 begin
 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
 625   begin
 626     kill := false;
 627     try
 628       try
 629         fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
 630         kill := true;
 631       except
 632         fs := fFileStream;
 633       end;
 634       result := TSFSPartialStream.Create(fs,
 635         TSFSFileInfo(fFiles[index]).fOfs,
 636         TSFSFileInfo(fFiles[index]).fSize, kill);
 637     except
 638       if kill then FreeAndNil(fs);
 639       result := nil;
 640     end;
 641   end
 642   else
 643   begin
 644     kill := false;
 645     try
 646       try
 647         fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
 648         kill := true;
 649       except
 650         fs := fFileStream;
 651       end;
 652       result := TSFSPartialStream.Create(fs,
 653         TSFSExtFileInfo(fFiles[index]).fOfs,
 654         TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf),
 655         kill,
 656         @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]),
 657         Length(TSFSExtFileInfo(fFiles[index]).fVBuf));
 658     except
 659       if kill then FreeAndNil(fs);
 660       result := nil;
 661     end;
 662   end;
 663 end;
 664
 665
 666 { TSFSPlainVolumeFactory }
 667 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
 668 begin
 669   result :=
 670     SFSStrEqu(prefix, 'pak') or
 671     //SFSStrEqu(prefix, 'wad') or // sorry
 672     SFSStrEqu(prefix, 'wad2') or
 673     SFSStrEqu(prefix, 'grp') or
 674     SFSStrEqu(prefix, 'spe') or
 675     SFSStrEqu(prefix, 'spec') or
 676     SFSStrEqu(prefix, 'quake') or
 677     SFSStrEqu(prefix, 'doom') or
 678     SFSStrEqu(prefix, 'duke3d') or
 679     SFSStrEqu(prefix, 'abuse') or
 680     SFSStrEqu(prefix, 'allegro') or
 681     SFSStrEqu(prefix, 'dune2') or
 682     SFSStrEqu(prefix, 'max') or
 683     SFSStrEqu(prefix, 'sin');
 684 end;
 685
 686 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
 687 begin
 688   vol.Free();
 689 end;
 690
 691 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
 692 var
 693   vt: TSFSPlainVolumeType;
 694 begin
 695   vt := sfspvNone;
 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!
 705
 706   if vt <> sfspvNone then
 707   begin
 708     result := TSFSPlainVolume.Create(fileName, st);
 709     TSFSPlainVolume(result).fType := vt;
 710     try
 711       result.DoDirectoryRead();
 712     except
 713       FreeAndNil(result);
 714       raise;
 715     end;
 716   end
 717   else result := nil;
 718 end;
 719
 720
 721 var
 722   pakf: TSFSPlainVolumeFactory;
 723 initialization
 724   pakf := TSFSPlainVolumeFactory.Create();
 725   SFSRegisterVolumeFactory(pakf);
 726 finalization
 727   SFSUnregisterVolumeFactory(pakf);
 728 end.