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 SFSStrComp(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) = 0 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     (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);
 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.