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 {.$DEFINE SFS_PLAINFS_FULL}
  22 {$MODE DELPHI}
  23 {.$R-}
  24 unit sfsPlainFS;
  25
  26 interface
  27
  28 uses
  29   SysUtils, Classes, Contnrs, sfs;
  30
  31
  32 type
  33   TSFSPlainVolumeType =
  34     (sfspvNone,
  35      sfspvPAK,
  36      sfspvSIN
  37      {$IFDEF SFS_PLAINFS_FULL}
  38      ,sfspvWAD,
  39      sfspvGRP,
  40      sfspvSPE,
  41      sfspvWAD2,
  42      sfspvALL,
  43      sfspvDune2,
  44      sfspvMAX
  45      {$ENDIF}
  46      );
  47
  48   TSFSPlainVolume = class (TSFSVolume)
  49   protected
  50     fType: TSFSPlainVolumeType;
  51
  52     procedure PAKReadDirectory ();
  53     procedure SINReadDirectory ();
  54     {$IFDEF SFS_PLAINFS_FULL}
  55     procedure WADReadDirectory ();
  56     procedure GRPReadDirectory ();
  57     procedure SPEReadDirectory ();
  58     procedure WAD2ReadDirectory ();
  59     procedure ALLReadDirectory ();
  60     procedure Dune2ReadDirectory ();
  61     procedure MAXReadDirectory ();
  62     {$ENDIF}
  63
  64     procedure ReadDirectory (); override;
  65
  66   public
  67     function OpenFileByIndex (const index: Integer): TStream; override;
  68   end;
  69
  70   TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
  71   public
  72     function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
  73     function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
  74     procedure Recycle (vol: TSFSVolume); override;
  75   end;
  76
  77
  78
  79 implementation
  80
  81 uses
  82   xstreams, utils;
  83
  84
  85 type
  86   TSFSExtFileInfo = class (TSFSFileInfo)
  87   public
  88     fVBuf: packed array of Byte;
  89     fLink: TSFSString;
  90   end;
  91
  92 {$IFDEF SFS_PLAINFS_FULL}
  93   TAllegroProperty = class
  94     name: TSFSString;
  95     ofs: Int64;
  96     size: Integer;
  97   end;
  98 {$ENDIF}
  99
 100
 101 function ReadMD (st: TStream): Integer;
 102 // read dword in big-endian format. portable.
 103 var
 104   buf: packed array [0..3] of Byte;
 105 begin
 106   st.ReadBuffer(buf[0], 4);
 107   result := (buf[0] shl 24) or (buf[1] shl 16) or (buf[2] shl 8) or buf[3];
 108 end;
 109
 110 {$IFDEF SFS_PLAINFS_FULL}
 111 function WADCheckMagic (st: TStream): Boolean;
 112 var
 113   sign: packed array [0..3] of Char;
 114   fcnt, dofs: Integer;
 115 begin
 116   result := false;
 117   st.ReadBuffer(sign[0], 4);
 118   st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
 119   st.Seek(-12, soCurrent);
 120   if (sign <> 'IWAD') and (sign <> 'PWAD') then exit;
 121   if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
 122      (dofs+fcnt*16 > st.Size) then exit;
 123   result := true;
 124 end;
 125 {$ENDIF}
 126
 127 function PAKCheckMagic (st: TStream): Boolean;
 128 var
 129   sign: packed array [0..3] of Char;
 130   dsize, dofs: Integer;
 131 begin
 132   result := false;
 133   st.ReadBuffer(sign[0], 4);
 134   st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
 135   st.Seek(-12, soCurrent);
 136   if sign <> 'PACK' then exit;
 137   if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
 138      (dsize mod 64 <> 0) then exit;
 139   result := true;
 140 end;
 141
 142 function SINCheckMagic (st: TStream): Boolean;
 143 var
 144   sign: packed array [0..3] of Char;
 145   dsize, dofs: Integer;
 146 begin
 147   result := false;
 148   st.ReadBuffer(sign[0], 4);
 149   st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
 150   st.Seek(-12, soCurrent);
 151   if sign <> 'SPAK' then exit;
 152   if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
 153      (dsize mod 64 <> 0) then exit;
 154   result := true;
 155 end;
 156
 157 {$IFDEF SFS_PLAINFS_FULL}
 158 function GRPCheckMagic (st: TStream): Boolean;
 159 var
 160   sign: packed array [0..11] of Char;
 161   fcnt: Integer;
 162 begin
 163   result := false;
 164   st.ReadBuffer(sign[0], 12);
 165   st.ReadBuffer(fcnt, 4);
 166   st.Seek(-16, soCurrent);
 167   if sign <> 'KenSilverman' then exit;
 168   if (fcnt < 0) or (fcnt*16 > st.Size-16) then exit;
 169   result := true;
 170 end;
 171
 172 function SPECheckMagic (st: TStream): Boolean;
 173 var
 174   sign: packed array [0..6] of Char;
 175   b: Byte;
 176   fcnt: Integer;
 177 begin
 178   result := false;
 179   st.ReadBuffer(sign[0], 7); st.ReadBuffer(b, 1);
 180   st.ReadBuffer(fcnt, 4);
 181   st.Seek(-12, soCurrent);
 182   if (sign <> 'SPEC1.0') or (b <> 0) or (fcnt < 0) then exit;
 183   result := true;
 184 end;
 185
 186 function WAD2CheckMagic (st: TStream): Boolean;
 187 var
 188   sign: packed array [0..3] of Char;
 189   fcnt, dofs: Integer;
 190 begin
 191   result := false;
 192   st.ReadBuffer(sign[0], 4);
 193   st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
 194   st.Seek(-12, soCurrent);
 195   if sign <> 'WAD2' then exit;
 196   if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
 197      (dofs+fcnt*32 > st.Size) then exit;
 198   result := true;
 199 end;
 200
 201 function ALLCheckMagic (st: TStream): Boolean;
 202 var
 203   sign0, sign1: packed array [0..3] of Char;
 204 begin
 205   result := false;
 206   st.ReadBuffer(sign0[0], 4);
 207   st.ReadBuffer(sign1[0], 4);
 208   st.Seek(-8, soCurrent);
 209   if sign0 = 'slh.' then
 210   begin
 211     if sign1 <> 'ALL.' then exit;
 212   end else if sign0 <> 'ALL.' then exit;
 213   result := true;
 214 end;
 215
 216 function Dune2CheckMagic (st: TStream): Boolean;
 217 var
 218   cpos, np, f: Integer;
 219 begin
 220   cpos := st.Position;
 221   st.ReadBuffer(np, 4);
 222   st.Position := np-4;
 223   st.ReadBuffer(f, 4);
 224   st.Position := cpos;
 225   result := (f = 0);
 226 end;
 227
 228 function MAXCheckMagic (st: TStream): Boolean;
 229 var
 230   sign: packed array [0..3] of Char;
 231   fcnt, dofs: Integer;
 232 begin
 233   result := false;
 234   st.ReadBuffer(sign[0], 4);
 235   st.ReadBuffer(dofs, 4); st.ReadBuffer(fcnt, 4);
 236   st.Seek(-12, soCurrent);
 237   if sign <> 'RES0' then exit;
 238   if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
 239      (dofs+fcnt > st.Size) then exit;
 240   result := true;
 241 end;
 242 {$ENDIF}
 243
 244
 245 { TSFSPlainVolume }
 246 {$IFDEF SFS_PLAINFS_FULL}
 247 procedure TSFSPlainVolume.WADReadDirectory ();
 248 var
 249   fcnt: LongWord;
 250   dofs: LongWord;
 251   fi: TSFSFileInfo;
 252   name: packed array [0..9] of Char;
 253 begin
 254   fFileStream.Seek(4, soCurrent); // skip signature
 255   fFileStream.ReadBuffer(fcnt, 4);
 256   fFileStream.ReadBuffer(dofs, 4);
 257   fFileStream.Position := dofs;
 258   while fcnt <> 0 do
 259   begin
 260     fi := TSFSFileInfo.Create(self);
 261     fFileStream.ReadBuffer(fi.fOfs, 4);
 262     fFileStream.ReadBuffer(fi.fSize, 4);
 263     FillChar(name[0], Length(name), 0);
 264     fFileStream.ReadBuffer(name[0], 8);
 265     fi.fName := PChar(@name[0]);
 266     Dec(fcnt);
 267   end;
 268 end;
 269 {$ENDIF}
 270
 271 procedure TSFSPlainVolume.PAKReadDirectory ();
 272 var
 273   dsize, dofs: LongWord;
 274   fi: TSFSFileInfo;
 275   name: packed array [0..56] of Char;
 276 begin
 277   fFileStream.Seek(4, soCurrent); // skip signature
 278   fFileStream.ReadBuffer(dofs, 4);
 279   fFileStream.ReadBuffer(dsize, 4);
 280   fFileStream.Position := dofs;
 281   while dsize >= 64 do
 282   begin
 283     fi := TSFSFileInfo.Create(self);
 284     FillChar(name[0], Length(name), 0);
 285     fFileStream.ReadBuffer(name[0], 56);
 286     fi.fName := PChar(@name[0]);
 287     fFileStream.ReadBuffer(fi.fOfs, 4);
 288     fFileStream.ReadBuffer(fi.fSize, 4);
 289     Dec(dsize, 64);
 290   end;
 291 end;
 292
 293 procedure TSFSPlainVolume.SINReadDirectory ();
 294 var
 295   dsize, dofs: LongWord;
 296   fi: TSFSFileInfo;
 297   name: packed array [0..120] of Char;
 298 begin
 299   fFileStream.Seek(4, soCurrent); // skip signature
 300   fFileStream.ReadBuffer(dofs, 4);
 301   fFileStream.ReadBuffer(dsize, 4);
 302   fFileStream.Position := dofs;
 303   while dsize >= 128 do
 304   begin
 305     fi := TSFSFileInfo.Create(self);
 306     FillChar(name[0], Length(name), 0);
 307     fFileStream.ReadBuffer(name[0], 120);
 308     fi.fName := PChar(@name[0]);
 309     fFileStream.ReadBuffer(fi.fOfs, 4);
 310     fFileStream.ReadBuffer(fi.fSize, 4);
 311     Dec(dsize, 128);
 312   end;
 313 end;
 314
 315 {$IFDEF SFS_PLAINFS_FULL}
 316 procedure TSFSPlainVolume.GRPReadDirectory ();
 317 var
 318   fcnt: LongWord;
 319   fi: TSFSFileInfo;
 320   name: packed array [0..12] of Char;
 321   ofs: Int64;
 322 begin
 323   fFileStream.Seek(12, soCurrent); // skip signature
 324   fFileStream.ReadBuffer(fcnt, 4);
 325   ofs := fFileStream.Position+fcnt*16;
 326   while fcnt <> 0 do
 327   begin
 328     fi := TSFSFileInfo.Create(self);
 329     fi.fOfs := ofs;
 330     FillChar(name[0], Length(name), 0);
 331     fFileStream.ReadBuffer(name[0], 12);
 332     fi.fName := PChar(@name[0]);
 333     fFileStream.ReadBuffer(fi.fSize, 4);
 334     Inc(ofs, fi.fSize);
 335     Dec(fcnt);
 336   end;
 337 end;
 338
 339 procedure TSFSPlainVolume.SPEReadDirectory ();
 340 var
 341   fcnt: Word;
 342   fi: TSFSExtFileInfo;
 343   {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 344   pp: TSFSString;
 345   {$ENDIF}
 346   name: ShortString;
 347   f, c: Integer;
 348   b: Byte;
 349   wasUnfixedLink: Boolean;
 350 begin
 351   fFileStream.Seek(8, soCurrent); // skip signature
 352   fFileStream.ReadBuffer(fcnt, 2);
 353   while fcnt <> 0 do
 354   begin
 355     fi := TSFSExtFileInfo.Create(self);
 356    {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 357     SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1);
 358    {$ELSE}
 359      SetLength(fi.fVBuf, 0);
 360     fFileStream.ReadBuffer(b, 1);
 361     pp := IntToHex(b, 2)+'/';
 362    {$ENDIF}
 363     fFileStream.ReadBuffer(name[0], 1);
 364     if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
 365     f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
 366     fi.fName := SFSReplacePathDelims(name, '/');
 367     if fi.fName = '' then fi.fName := 'untitled_file';
 368     if fi.fName[1] = '/' then Delete(fi.fName, 1, 1);
 369    {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 370     fi.fName := pp+fi.fName;
 371    {$ENDIF}
 372     fFileStream.ReadBuffer(b, 1);
 373     if (b and $01) <> 0 then
 374     begin
 375       // link
 376       fFileStream.ReadBuffer(name[0], 1);
 377       if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
 378       f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
 379       if name[0] = #0 then name := #0;
 380       fi.fLink := name;
 381     end
 382     else
 383     begin
 384       fi.fLink := '';
 385       fFileStream.ReadBuffer(fi.fSize, 4);
 386      {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
 387       Inc(fi.fSize); // plus type byte
 388      {$ENDIF}
 389       fFileStream.ReadBuffer(fi.fOfs, 4);
 390     end;
 391     Dec(fcnt);
 392   end;
 393
 394   // now fixup links
 395   // nobody uses this shit, but it was documented by JC. %-)
 396   // i even allow links to links! %-)
 397   wasUnfixedLink := true;
 398   while wasUnfixedLink do
 399   begin
 400     f := 0; wasUnfixedLink := false;
 401     while f < fFiles.Count do
 402     begin
 403       fi := TSFSExtFileInfo(fFiles[f]); Inc(f);
 404       if (fi = nil) or (fi.fLink = '') then continue;
 405       c := 0;
 406       while c < fFiles.Count do
 407       begin
 408         if c <> f then
 409         begin
 410           // link can't be linked to itself
 411           if StrEquCI1251(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) then break;
 412         end;
 413         Inc(c);
 414       end;
 415       if c < fFiles.Count then
 416       begin
 417         if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true
 418         else
 419         begin
 420           TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs;
 421           TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize;
 422           TSFSExtFileInfo(fFiles[c]).fLink := '';
 423         end;
 424       end
 425       else begin Dec(f); fFiles.Delete(f); end; // invalid link
 426     end;
 427   end;
 428 end;
 429
 430 procedure TSFSPlainVolume.WAD2ReadDirectory ();
 431 var
 432   fcnt, dofs: LongWord;
 433   fi: TSFSFileInfo;
 434   name: packed array [0..16] of Char;
 435   f, c: Integer;
 436 begin
 437   fFileStream.Seek(4, soCurrent); // skip signature
 438   fFileStream.ReadBuffer(fcnt, 4);
 439   fFileStream.ReadBuffer(dofs, 4);
 440   fFileStream.Position := dofs;
 441   while fcnt <> 0 do
 442   begin
 443     fi := TSFSFileInfo.Create(self);
 444     fFileStream.ReadBuffer(fi.fOfs, 4);
 445     fFileStream.ReadBuffer(fi.fSize, 4);
 446     fFileStream.ReadBuffer(f, 4);
 447     fFileStream.ReadBuffer(c, 4);
 448     FillChar(name[0], Length(name), 0);
 449     fFileStream.ReadBuffer(name[0], 16);
 450     fi.fName := PChar(@name[0]);
 451     Dec(fcnt);
 452   end;
 453 end;
 454
 455 procedure TSFSPlainVolume.ALLReadDirectory ();
 456 var
 457   fcnt: Integer;
 458   fi: TSFSFileInfo;
 459   sign: packed array [0..3] of Char;
 460   nameList: TStringList;
 461   propList: TObjectList;
 462   name: ShortString;
 463   f, c: Integer;
 464   prp: TAllegroProperty;
 465 begin
 466   nameList := TStringList.Create(); propList := nil;
 467   try
 468     propList := TObjectList.Create(true);
 469     fFileStream.ReadBuffer(sign[0], 4);
 470     if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4);
 471     // signature skipped
 472     fcnt := ReadMD(fFileStream);
 473     while fcnt > 0 do
 474     begin
 475       // collect properties
 476       nameList.Clear(); propList.Clear();
 477       repeat
 478         fFileStream.ReadBuffer(sign[0], 4);
 479         if sign <> 'prop' then break;
 480         fFileStream.ReadBuffer(sign[0], 4);
 481         f := ReadMD(fFileStream); // size
 482         if f < 0 then
 483         begin
 484          {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 485           WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8));
 486          {$ENDIF}
 487           raise ESFSError.Create('invalid ALLEGRO file');
 488         end;
 489         if sign = 'NAME' then
 490         begin
 491           if f > 255 then c := 255 else c := f;
 492           FillChar(name, SizeOf(name), 0);
 493           fFileStream.ReadBuffer(name[1], c); name[0] := chr(c);
 494           Dec(f, c);
 495           c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
 496           nameList.Add(name);
 497         end
 498         else
 499         begin
 500           prp := TAllegroProperty.Create();
 501           Move(sign[0], name[1], 4); name[0] := #4;
 502           c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
 503           prp.name := sign;
 504           prp.ofs := fFileStream.Position;
 505           prp.size := f;
 506           propList.Add(prp);
 507         end;
 508         fFileStream.Seek(f, soCurrent);
 509       until false;
 510       if nameList.Count = 0 then nameList.Add('untitled_file');
 511
 512       Move(sign[0], name[1], 4); name[5] := #0;
 513       f := 1; while (f <= 4) and (name[f] <> #0) do Inc(f);
 514       while (f > 0) and (name[f] <= ' ') do Dec(f);
 515       name[0] := chr(f);
 516
 517       // read size
 518       f := ReadMD(fFileStream);
 519       c := ReadMD(fFileStream);
 520       if f <> c then
 521       begin
 522        {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 523         WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8));
 524        {$ENDIF}
 525         raise ESFSError.Create('invalid ALLEGRO file');
 526       end;
 527
 528       // add files
 529       while nameList.Count > 0 do
 530       begin
 531         fi := TSFSFileInfo.Create(self);
 532         fi.fName := nameList[0];
 533         fi.fPath := name;
 534         fi.fSize := c;
 535         fi.fOfs := fFileStream.Position;
 536         // add properties
 537         for f := 0 to propList.Count-1 do
 538         begin
 539           prp := TAllegroProperty(propList[f]);
 540           fi := TSFSFileInfo.Create(self);
 541           fi.fName := prp.name;
 542           fi.fPath := name+'.props/'+nameList[0];
 543           fi.fSize := prp.size;
 544           fi.fOfs := prp.ofs;
 545         end;
 546         nameList.Delete(0);
 547       end;
 548       fFileStream.Seek(c, soCurrent);
 549       Dec(fcnt);
 550     end;
 551    {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
 552     WriteLn(ErrOutput, 'ALLEGRO: ok');
 553    {$ENDIF}
 554   finally
 555     propList.Free();
 556     nameList.Free();
 557   end;
 558 end;
 559
 560 procedure TSFSPlainVolume.Dune2ReadDirectory ();
 561 var
 562   ofs: LongWord;
 563   fi: TSFSFileInfo;
 564   name: string[255];
 565   ch: Char;
 566 begin
 567   repeat
 568     fFileStream.ReadBuffer(ofs, 4);
 569     if ofs = 0 then break;
 570     name[0] := #0;
 571     fFileStream.ReadBuffer(ch, 1);
 572     while ch <> #0 do
 573     begin
 574       if name[0] <> #255 then
 575       begin
 576         Inc(name[0]); name[ord(name[0])] := ch;
 577       end;
 578       fFileStream.ReadBuffer(ch, 1);
 579     end;
 580     if fFiles.Count > 0 then
 581     begin
 582       fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 583       fi.fSize := ofs-fi.fOfs;
 584     end;
 585     fi := TSFSFileInfo.Create(self);
 586     fi.fOfs := ofs;
 587     fi.fSize := 0;
 588     fi.fName := name;
 589   until false;
 590   if fFiles.Count > 0 then
 591   begin
 592     fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
 593     fi.fSize := fFileStream.Size-fi.fOfs;
 594   end;
 595 end;
 596
 597 procedure TSFSPlainVolume.MAXReadDirectory ();
 598 var
 599   fcnt: LongInt;
 600   dofs: LongWord;
 601   fi: TSFSFileInfo;
 602   name: packed array [0..9] of Char;
 603 begin
 604   fFileStream.Seek(4, soCurrent); // skip signature
 605   fFileStream.ReadBuffer(dofs, 4);
 606   fFileStream.ReadBuffer(fcnt, 4);
 607   fFileStream.Position := dofs;
 608   while fcnt >= 16 do
 609   begin
 610     fi := TSFSFileInfo.Create(self);
 611     FillChar(name[0], Length(name), 0);
 612     fFileStream.ReadBuffer(name[0], 8);
 613     fFileStream.ReadBuffer(fi.fOfs, 4);
 614     fFileStream.ReadBuffer(fi.fSize, 4);
 615     fi.fName := PChar(@name[0]);
 616     Dec(fcnt, 16);
 617   end;
 618 end;
 619 {$ENDIF}
 620
 621 procedure TSFSPlainVolume.ReadDirectory ();
 622 begin
 623   case fType of
 624     sfspvPAK: PAKReadDirectory();
 625     sfspvSIN: SINReadDirectory();
 626     {$IFDEF SFS_PLAINFS_FULL}
 627     sfspvWAD: WADReadDirectory();
 628     sfspvGRP: GRPReadDirectory();
 629     sfspvSPE: SPEReadDirectory();
 630     sfspvWAD2: WAD2ReadDirectory();
 631     sfspvALL: ALLReadDirectory();
 632     sfspvDune2: Dune2ReadDirectory();
 633     sfspvMAX: MAXReadDirectory();
 634     {$ENDIF}
 635     else raise ESFSError.Create('invalid plain SFS');
 636   end;
 637 end;
 638
 639 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
 640 var
 641   fs: TStream;
 642   kill: Boolean;
 643 begin
 644   result := nil; fs := nil;
 645   if fFiles = nil then exit;
 646   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
 647   if not (fFiles[index] is TSFSExtFileInfo) or
 648      (Length(TSFSExtFileInfo(fFiles[index]).fVBuf) < 1) then
 649   begin
 650     kill := false;
 651     try
 652       try
 653         fs := TFileStream.Create(fFileName, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
 654         kill := true;
 655       except
 656         fs := fFileStream;
 657       end;
 658       result := TSFSPartialStream.Create(fs,
 659         TSFSFileInfo(fFiles[index]).fOfs,
 660         TSFSFileInfo(fFiles[index]).fSize, kill);
 661     except
 662       if kill then FreeAndNil(fs);
 663       result := nil;
 664     end;
 665   end
 666   else
 667   begin
 668     kill := false;
 669     try
 670       try
 671         fs := TFileStream.Create(fFileName, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
 672         kill := true;
 673       except
 674         fs := fFileStream;
 675       end;
 676       result := TSFSPartialStream.Create(fs,
 677         TSFSExtFileInfo(fFiles[index]).fOfs,
 678         TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf),
 679         kill,
 680         @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]),
 681         Length(TSFSExtFileInfo(fFiles[index]).fVBuf));
 682     except
 683       if kill then FreeAndNil(fs);
 684       result := nil;
 685     end;
 686   end;
 687 end;
 688
 689
 690 { TSFSPlainVolumeFactory }
 691 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
 692 begin
 693   result :=
 694     StrEquCI1251(prefix, 'pak') or
 695     StrEquCI1251(prefix, 'sin') or
 696     StrEquCI1251(prefix, 'quake')
 697     {$IFDEF SFS_PLAINFS_FULL}
 698     or
 699     StrEquCI1251(prefix, 'wad') or // sorry
 700     StrEquCI1251(prefix, 'wad2') or
 701     StrEquCI1251(prefix, 'grp') or
 702     StrEquCI1251(prefix, 'spe') or
 703     StrEquCI1251(prefix, 'spec') or
 704     StrEquCI1251(prefix, 'doom') or
 705     StrEquCI1251(prefix, 'duke3d') or
 706     StrEquCI1251(prefix, 'abuse') or
 707     StrEquCI1251(prefix, 'allegro') or
 708     StrEquCI1251(prefix, 'dune2') or
 709     StrEquCI1251(prefix, 'max')
 710     {$ENDIF}
 711     ;
 712 end;
 713
 714 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
 715 begin
 716   vol.Free();
 717 end;
 718
 719 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
 720 var
 721   vt: TSFSPlainVolumeType;
 722 begin
 723   vt := sfspvNone;
 724   if PAKCheckMagic(st) then vt := sfspvPAK
 725   else if SINCheckMagic(st) then vt := sfspvSIN
 726   {$IFDEF SFS_PLAINFS_FULL}
 727   else if WADCheckMagic(st) then vt := sfspvWAD
 728   else if GRPCheckMagic(st) then vt := sfspvGRP
 729   else if SPECheckMagic(st) then vt := sfspvSPE
 730   else if WAD2CheckMagic(st) then vt := sfspvWAD2
 731   //else if ALLCheckMagic(st) then vt := sfspvALL
 732   else if MAXCheckMagic(st) then vt := sfspvMAX
 733   //else if Dune2CheckMagic(st) then vt := sfspvDune2 // this must be the last!
 734   {$ENDIF}
 735   ;
 736
 737   if vt <> sfspvNone then
 738   begin
 739     result := TSFSPlainVolume.Create(fileName, st);
 740     TSFSPlainVolume(result).fType := vt;
 741     try
 742       result.DoDirectoryRead();
 743     except
 744       FreeAndNil(result);
 745       raise;
 746     end;
 747   end
 748   else result := nil;
 749 end;
 750
 751
 752 var
 753   pakf: TSFSPlainVolumeFactory;
 754 initialization
 755   pakf := TSFSPlainVolumeFactory.Create();
 756   SFSRegisterVolumeFactory(pakf);
 757 //finalization
 758 //  SFSUnregisterVolumeFactory(pakf);
 759 end.