src/sfs/sfsMemFS.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 // "memory group". reads the whole pack in memory (and decompress it if
   6 // necessary). memory image has only one file named "<body>".
   7 //
   8 // now understands:
   9 //   slh!: DOS Allegro "slh!"
  10 //   mem : raw file (no processing, just read)
  11 //     as a side effect this gives us an opportunity to read enclosed packs
  12 //     from the packs which aren't supporting backseeking (such as zips).
  13 //
  14 {.$DEFINE SFS_MSMFS}
  15 {$MODE DELPHI}
  16 {.$R-}
  17 unit sfsMemFS;
  18
  19 interface
  20
  21 {$IFDEF SFS_MSMFS}
  22 uses
  23   SysUtils, Classes, Contnrs, sfs;
  24
  25
  26 type
  27   TSFSMemVolumeType = (sfsmvNone, sfsmvRAW, sfsmvSLH);
  28
  29   TSFSMemoryVolume = class(TSFSVolume)
  30   protected
  31     fType: TSFSMemVolumeType;
  32     fMemStream: TMemoryStream;
  33
  34     procedure RAWRead ();
  35     procedure SLHRead ();
  36
  37     procedure ReadDirectory (); override;
  38
  39   public
  40     function OpenFileByIndex (const index: Integer): TStream; override;
  41   end;
  42
  43   TSFSMemoryVolumeFactory = class (TSFSVolumeFactory)
  44   public
  45     function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
  46     function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
  47     procedure Recycle (vol: TSFSVolume); override;
  48   end;
  49 {$ENDIF}
  50
  51
  52 implementation
  53
  54 {$IFDEF SFS_MSMFS}
  55 uses
  56   xstreams, utils;
  57
  58
  59 function SLHCheckMagic (st: TStream): Boolean;
  60 var
  61   sign: packed array [0..3] of Char;
  62 begin
  63   result := false;
  64   st.ReadBuffer(sign[0], 4);
  65   st.Seek(-4, soCurrent);
  66   if sign <> 'slh!' then exit;
  67   result := true;
  68 end;
  69
  70
  71 { TSFSMemoryVolume }
  72 procedure TSFSMemoryVolume.RAWRead ();
  73 var
  74   fi: TSFSFileInfo;
  75 begin
  76   fMemStream.CopyFrom(fFileStream, 0); // voila %-)
  77   fi := TSFSFileInfo.Create(self);
  78   fi.fName := '<body>';
  79   fi.fSize := fMemStream.Size;
  80 end;
  81
  82 procedure TSFSMemoryVolume.SLHRead ();
  83 // unpack LZSS-packed file
  84 var
  85   fi: TSFSFileInfo;
  86   bufi, bufo: packed array of Byte;
  87   iused, oused, rpos: Integer;
  88   dict: packed array of Byte;
  89   flags, dpos, pos, len: Word;
  90   c: Integer;
  91
  92   function ReadCh (): Integer;
  93   begin
  94     if rpos >= iused then
  95     begin
  96       // int64!
  97       if fFileStream.Size-fFileStream.Position > Length(bufi) then iused := Length(bufi)
  98       else iused := fFileStream.Size-fFileStream.Position;
  99       rpos := 0;
 100       if iused > 0 then fFileStream.ReadBuffer(bufi[0], iused);
 101     end;
 102
 103     if iused = 0 then result := -1
 104     else begin result := bufi[rpos]; Inc(rpos); end;
 105   end;
 106
 107   procedure WriteCh (c: Byte);
 108   begin
 109     if oused >= Length(bufo) then
 110     begin
 111       fMemStream.WriteBuffer(bufo[0], oused);
 112       oused := 0;
 113     end;
 114     bufo[oused] := c; Inc(oused);
 115     dict[dpos] := c; dpos := (dpos+1) and $FFF;
 116   end;
 117
 118 begin
 119   fFileStream.Seek(4, soCurrent); // skip signature
 120   SetLength(bufi, 65536); SetLength(bufo, 65536); SetLength(dict, 4096);
 121   rpos := 0; iused := 0; oused := 0;
 122   flags := 0; dpos := 4096-18;
 123   repeat
 124     if (flags and $FF00) = 0 then
 125     begin
 126       c := ReadCh(); if c = -1 then break;
 127       flags := c or $FF00;
 128     end;
 129
 130     if (flags and $01) <> 0 then
 131     begin
 132       // literal
 133       c := ReadCh(); if c = -1 then break;
 134       WriteCh(c);
 135     end
 136     else
 137     begin
 138       // "copy"
 139       c := ReadCh(); if c = -1 then break;
 140       pos := c;
 141       c := ReadCh(); if c = -1 then break;
 142       len := c;
 143       pos := (pos and $FF) or ((len and $F0) shl 4); len := (len and $0F)+3;
 144       while len > 0 do
 145       begin
 146         c := dict[pos]; pos := (pos+1) and $FFF; Dec(len);
 147         WriteCh(c);
 148       end;
 149     end;
 150     flags := flags shr 1;
 151   until false;
 152   if oused > 0 then fMemStream.WriteBuffer(bufo[0], oused);
 153
 154   fi := TSFSFileInfo.Create(self);
 155   fi.fName := '<body>';
 156   fi.fSize := fMemStream.Size;
 157 end;
 158
 159 procedure TSFSMemoryVolume.ReadDirectory ();
 160 begin
 161   if fMemStream = nil then fMemStream := TMemoryStream.Create()
 162   else
 163   begin
 164     fMemStream.Position := 0; fMemStream.Size := 0;
 165   end;
 166
 167   case fType of
 168     sfsmvSLH: SLHRead();
 169     sfsmvRAW: RAWRead();
 170     else raise ESFSError.Create('invalid memory SFS');
 171   end;
 172
 173   fMemStream.Position := 0;
 174 end;
 175
 176 function TSFSMemoryVolume.OpenFileByIndex (const index: Integer): TStream;
 177 var
 178   fs: TStream;
 179 begin
 180   result := nil; fs := nil;
 181   if fFiles = nil then exit;
 182   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
 183
 184   try
 185     fs := TSFSMemoryStreamRO.Create(fMemStream.Memory, fMemStream.Size);
 186     if fFiles.Count = 1 then
 187     begin
 188       result := fs;
 189     end
 190     else
 191     begin
 192       try
 193         result := TSFSPartialStream.Create(fs,
 194           TSFSFileInfo(fFiles[index]).fOfs,
 195           TSFSFileInfo(fFiles[index]).fSize, true);
 196       except
 197         FreeAndNil(fs);
 198         raise;
 199       end;
 200     end;
 201   except
 202     result := nil;
 203   end;
 204 end;
 205
 206
 207 { TSFSMemoryVolumeFactory }
 208 function TSFSMemoryVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
 209 begin
 210   result :=
 211     StrEquCI1251(prefix, 'mem') or
 212     StrEquCI1251(prefix, 'slh!');
 213 end;
 214
 215 procedure TSFSMemoryVolumeFactory.Recycle (vol: TSFSVolume);
 216 begin
 217   vol.Free();
 218 end;
 219
 220 function TSFSMemoryVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
 221 var
 222   vt: TSFSMemVolumeType;
 223 begin
 224   if (prefix <> 'mem') and SLHCheckMagic(st) then vt := sfsmvSLH
 225   else if prefix <> '' then vt := sfsmvRAW
 226   else vt := sfsmvNone;
 227
 228   result := TSFSMemoryVolume.Create(fileName, st);
 229   TSFSMemoryVolume(result).fType := vt;
 230   try
 231     result.DoDirectoryRead();
 232   except
 233     FreeAndNil(result);
 234     raise;
 235   end;
 236 end;
 237
 238
 239 var
 240   memf: TSFSMemoryVolumeFactory;
 241 initialization
 242   memf := TSFSMemoryVolumeFactory.Create();
 243   SFSRegisterVolumeFactory(memf);
 244 //finalization
 245 //  SFSUnregisterVolumeFactory(memf);
 246 {$ENDIF}
 247 end.