src/sfs/sfsPlainFS.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 // simple grouping files w/o packing:
  17 //   Quake I/II .PAK (PACK)
  18 //   SiN .SIN (SPAK)
  19 //
  20 {$INCLUDE ../shared/a_modes.inc}
  21 {$SCOPEDENUMS OFF}
  22 {.$R+}
  23 unit sfsPlainFS;
  24
  25 interface
  26
  27 uses
  28   SysUtils, Classes, Contnrs, sfs;
  29
  30
  31 type
  32   TSFSPlainVolumeType = (sfspvNone, sfspvPAK, sfspvSIN);
  33
  34   TSFSPlainVolume = class (TSFSVolume)
  35   protected
  36     fType: TSFSPlainVolumeType;
  37
  38     procedure ReadDirectory (); override;
  39
  40   public
  41     function OpenFileByIndex (const index: Integer): TStream; override;
  42   end;
  43
  44   TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
  45   public
  46     function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
  47     function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
  48     procedure Recycle (vol: TSFSVolume); override;
  49   end;
  50
  51
  52 implementation
  53
  54 uses
  55   xstreams, utils;
  56
  57
  58 { TSFSPlainVolume }
  59 procedure TSFSPlainVolume.ReadDirectory ();
  60 var
  61   dsize, dofs, esz: LongWord;
  62   fi: TSFSFileInfo;
  63   name: packed array [0..120] of Char;
  64 begin
  65   if (fType <> sfspvPAK) and (fType <> sfspvSIN) then raise ESFSError.Create('invalid archive');
  66   fFileStream.Seek(4, soCurrent); // skip signature
  67   dofs := readLongWord(fFileStream);
  68   dsize := readLongWord(fFileStream);
  69   fFileStream.Position := dofs;
  70   if fType = sfspvPAK then esz := 64 else esz := 128;
  71   while dsize >= esz do
  72   begin
  73     fi := TSFSFileInfo.Create(self);
  74     FillChar(name[0], length(name), 0);
  75     fFileStream.ReadBuffer(name[0], esz-8);
  76     fi.fName := PChar(@name[0]);
  77     fi.fOfs := readLongWord(fFileStream);
  78     fi.fSize := readLongWord(fFileStream);
  79     Dec(dsize, esz);
  80   end;
  81 end;
  82
  83 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
  84 begin
  85   result := nil;
  86   if fFiles = nil then exit;
  87   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
  88   result := TSFSPartialStream.Create(fFileStream, TSFSFileInfo(fFiles[index]).fOfs, TSFSFileInfo(fFiles[index]).fSize, false);
  89 end;
  90
  91
  92 { TSFSPlainVolumeFactory }
  93 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
  94 begin
  95   result :=
  96     StrEquCI1251(prefix, 'pak') or
  97     StrEquCI1251(prefix, 'sin');
  98 end;
  99
 100 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
 101 begin
 102   vol.Free();
 103 end;
 104
 105 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
 106 var
 107   vt: TSFSPlainVolumeType;
 108   sign: packed array [0..3] of Char;
 109   dsize, dofs: Integer;
 110 begin
 111   result := nil;
 112   vt := sfspvNone;
 113
 114   st.ReadBuffer(sign[0], 4);
 115   dofs := readLongWord(st);
 116   dsize := readLongWord(st);
 117   st.Seek(-12, soCurrent);
 118   if sign = 'PACK' then
 119   begin
 120     if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
 121     vt := sfspvPAK;
 122   end
 123   else if sign = 'SPAK' then
 124   begin
 125     if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
 126     vt := sfspvSIN;
 127   end;
 128
 129   result := TSFSPlainVolume.Create(fileName, st);
 130   TSFSPlainVolume(result).fType := vt;
 131   try
 132     result.DoDirectoryRead();
 133   except
 134     FreeAndNil(result);
 135     raise;
 136   end;
 137 end;
 138
 139
 140 var
 141   pakf: TSFSPlainVolumeFactory;
 142 initialization
 143   pakf := TSFSPlainVolumeFactory.Create();
 144   SFSRegisterVolumeFactory(pakf);
 145 //finalization
 146 //  SFSUnregisterVolumeFactory(pakf);
 147 end.