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 {.$R+}
  22 unit sfsPlainFS;
  23
  24 interface
  25
  26 uses
  27   SysUtils, Classes, Contnrs, sfs;
  28
  29
  30 type
  31   TSFSPlainVolumeType = (sfspvNone, sfspvPAK, sfspvSIN);
  32
  33   TSFSPlainVolume = class (TSFSVolume)
  34   protected
  35     fType: TSFSPlainVolumeType;
  36
  37     procedure ReadDirectory (); override;
  38
  39   public
  40     function OpenFileByIndex (const index: Integer): TStream; override;
  41   end;
  42
  43   TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
  44   public
  45     function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
  46     function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
  47     procedure Recycle (vol: TSFSVolume); override;
  48   end;
  49
  50
  51 implementation
  52
  53 uses
  54   xstreams, utils;
  55
  56
  57 { TSFSPlainVolume }
  58 procedure TSFSPlainVolume.ReadDirectory ();
  59 var
  60   dsize, dofs, esz: LongWord;
  61   fi: TSFSFileInfo;
  62   name: packed array [0..120] of Char;
  63 begin
  64   if (fType <> sfspvPAK) and (fType <> sfspvSIN) then raise ESFSError.Create('invalid archive');
  65   fFileStream.Seek(4, soCurrent); // skip signature
  66   dofs := readLongWord(fFileStream);
  67   dsize := readLongWord(fFileStream);
  68   fFileStream.Position := dofs;
  69   if fType = sfspvPAK then esz := 64 else esz := 128;
  70   while dsize >= esz do
  71   begin
  72     fi := TSFSFileInfo.Create(self);
  73     FillChar(name[0], length(name), 0);
  74     fFileStream.ReadBuffer(name[0], esz-8);
  75     fi.fName := PChar(@name[0]);
  76     fi.fOfs := readLongWord(fFileStream);
  77     fi.fSize := readLongWord(fFileStream);
  78     Dec(dsize, esz);
  79   end;
  80 end;
  81
  82 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
  83 begin
  84   result := nil;
  85   if fFiles = nil then exit;
  86   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
  87   result := TSFSPartialStream.Create(fFileStream, TSFSFileInfo(fFiles[index]).fOfs, TSFSFileInfo(fFiles[index]).fSize, false);
  88 end;
  89
  90
  91 { TSFSPlainVolumeFactory }
  92 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
  93 begin
  94   result :=
  95     StrEquCI1251(prefix, 'pak') or
  96     StrEquCI1251(prefix, 'sin');
  97 end;
  98
  99 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
 100 begin
 101   vol.Free();
 102 end;
 103
 104 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
 105 var
 106   vt: TSFSPlainVolumeType;
 107   sign: packed array [0..3] of Char;
 108   dsize, dofs: Integer;
 109 begin
 110   result := nil;
 111   vt := sfspvNone;
 112
 113   st.ReadBuffer(sign[0], 4);
 114   dofs := readLongWord(st);
 115   dsize := readLongWord(st);
 116   st.Seek(-12, soCurrent);
 117   if sign = 'PACK' then
 118   begin
 119     if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
 120     vt := sfspvPAK;
 121   end
 122   else if sign = 'SPAK' then
 123   begin
 124     if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
 125     vt := sfspvSIN;
 126   end;
 127
 128   result := TSFSPlainVolume.Create(fileName, st);
 129   TSFSPlainVolume(result).fType := vt;
 130   try
 131     result.DoDirectoryRead();
 132   except
 133     FreeAndNil(result);
 134     raise;
 135   end;
 136 end;
 137
 138
 139 var
 140   pakf: TSFSPlainVolumeFactory;
 141 initialization
 142   pakf := TSFSPlainVolumeFactory.Create();
 143   SFSRegisterVolumeFactory(pakf);
 144 //finalization
 145 //  SFSUnregisterVolumeFactory(pakf);
 146 end.