added my old SFS (vfs ;-) system

diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr
index 8b2ec19d63b1b45171056b45cf53aa07d2fd5556..e72de94e0ba79020a72ee529f7d9e1c84622dc2b 100644 (file)
--- a/src/game/Doom2DF.dpr
+++ b/src/game/Doom2DF.dpr
@@ -40,6 +40,11 @@ uses
   e_sound in '../engine/e_sound.pas',
   e_textures in '../engine/e_textures.pas',
   e_fixedbuffer in '../engine/e_fixedbuffer.pas',
+  sfs in '../sfs/sfs.pas',
+  sfsPlainFS in '../sfs/sfsPlainFS.pas',
+  sfsZipFS in '../sfs/sfsZipFS.pas',
+  sfsMemFS in '../sfs/sfsMemFS.pas',
+  xstreams in '../sfs/xstreams.pas',
   WADEDITOR in '../shared/WADEDITOR.pas',
   WADSTRUCT in '../shared/WADSTRUCT.pas',
   MAPSTRUCT in '../shared/MAPSTRUCT.pas',

diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas
new file mode 100644 (file)
index 0000000..3fa92fa
--- /dev/null
+++ b/src/sfs/sfs.pas
@@ -0,0 +1,1186 @@
+// streaming file system (virtual)
+{$MODE DELPHI}
+{.$R-}
+unit sfs;
+
+interface
+
+uses
+  SysUtils, Classes, Contnrs;
+
+
+type
+  ESFSError = class(Exception);
+
+  TSFSChar = AnsiChar;
+  TSFSString = AnsiString;
+
+  TSFSVolume = class;
+
+  TSFSFileInfo = class
+  public
+    fOwner: TSFSVolume; // òàê, íà âñÿêèé ñëó÷àé
+    fPath: TSFSString;  // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/"
+    fName: TSFSString;  // òîëüêî èìÿ
+    fSize: Int64;       // unpacked
+    fOfs: Int64;        // in VFS (many of 'em need this %-)
+
+    constructor Create (pOwner: TSFSVolume);
+    destructor Destroy (); override;
+
+    property path: TSFSString read fPath;
+    property name: TSFSString read fName;
+    property size: Int64 read fSize;
+  end;
+
+  // âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß!
+  // òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè!
+  TSFSVolume = class
+  protected
+    fFileName: TSFSString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà
+    fFileStream: TStream; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà
+    fFiles: TObjectList;  // TSFSFileInfo èëè íàñëåäíèêè
+
+    // ïðèøèáèòü âñå ñòðóêòóðû.
+    // íå äîëæíà ïàäàòü, åñëè å¸ âûçûâàþò íåñêîëüêî ðàç.
+    procedure Clear (); virtual;
+
+    // âûçûâàåòñÿ èç DoDirectoryRead() äëÿ çàïîëíåíèÿ ñïèñêà ôàéëîâ.
+    // ñ÷èòàåòñÿ, ÷òî âñå ìàãèêè óæå ïðîâåðåíû è ôàéë òî÷íî íàø.
+    // fFileName, fFileStream óæå óñòàíîâëåíû, fFiles ñîçäàí,
+    // â í¸ì, ñêîðåå âñåãî, íèêîãî íåò.
+    // ïîçèöèÿ ïîòîêà -- òà, ÷òî îñòàâèëà ôàáðèêà.
+    // ïðè îøèáêàõ êèäàòü èñêëþ÷åíèå, òîãäà òîì áóäåò ïðèáèò ôàáðèêîé.
+    // ðàçäåëèòåëè ïóòåé äîëæíû áûòü òîëüêî "/", êîðíåâîé "/" äîëæåí
+    // áûòü îïóùåí, ïóòè (åñëè íå ïóñòûå) äîëæíû çàâåðøàòüñÿ "/"!
+    // fName äîëæíî ñîäåðæàòü òîëüêî èìÿ, fPath -- òîëüêî ïóòü.
+    // â ïðèíöèïå, îá ýòîì ïîçàáîòèòñÿ DoDirectoryRead(), íî çà÷åì
+    // äàâàòü åìó ëèøíþþ ðàáîòó?
+    procedure ReadDirectory (); virtual; abstract;
+
+    // íàéòè ôàéë, âåðíóòü åãî èíäåêñ â fFiles.
+    // ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles!
+    // fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí.
+    // åñëè ôàéë íå íàéäåí, âåðíóòü -1.
+    function FindFile (const fPath, fName: TSFSString): Integer; virtual;
+
+    // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè.
+    function OpenFileByIndex (const index: Integer): TStream; virtual; abstract;
+
+    // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles
+    function GetFileCount (): Integer; virtual;
+
+    // âîçâðàùàåò ôàéë ñ èíäåêñîì index.
+    // ìîæåò âîçâðàùàòü NIL.
+    // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
+    function GetFiles (index: Integer): TSFSFileInfo; virtual;
+
+  public
+    // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
+    constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
+    // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
+    destructor Destroy (); override;
+
+    // âûçûâàåò ReadDirectory().
+    // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â
+    // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð.
+    // òàêæå îíà íîðìàëèçóåò âèä èì¸í.
+    procedure DoDirectoryRead ();
+
+    // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
+    function OpenFileEx (const fName: TSFSString): TStream; virtual;
+
+    property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü
+    // ìîæåò âîçâðàùàòü NIL.
+    // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
+    property Files [index: Integer]: TSFSFileInfo read GetFiles;
+  end;
+
+  // ôàáðèêà òîìîâ. âñå SFS ïðè ñòàðòå äîáàâëÿþò ñâîè ôàáðèêè.
+  // áëàãîäàðÿ ýòîìó ìîæíî ñîçäàâàòü ðàçíûå âñÿêèå SFS ñòàíäàðòíûì
+  // âûçîâîì ñòàíäàðòíîé ïðîöåäóðû.
+  // ôàáðèêà ÍÅ ÄÎËÆÍÀ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè âûçîâà
+  // SFSUnregisterVolumeFactory()! ýòî ãàðàíòèðóåò, ÷òî äâèæîê
+  // ïåðåä ðàññòðåëîì îòäàñò åé âñå å¸ òîìà.
+  TSFSVolumeFactory = class
+  public
+    // åñëè äîáàâëÿåì ôàéë äàííûõ ôàéë ñ èìåíåì òèïà "zip:....", òî
+    // SFS èçâëå÷¸ò ýòî "zip" è ïåðåäàñò â ñèþ ôóíêöèþ.
+    // åæåëè ôóíêöèÿ âåðí¸ò ïðàâäó, òî SFS âûçîâåò Produce äëÿ äàííîãî
+    // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò.
+    // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà.
+    // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ!
+    function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract;
+    // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà.
+    // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå.
+    // ýòîò ïîòîê íåëüçÿ çàêðûâàòü!
+    // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''.
+    // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé.
+    function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract;
+    // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó.
+    // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì.
+    procedure Recycle (vol: TSFSVolume); virtual; abstract;
+  end;
+
+  // "èòåðàòîð", âîçâðàùàåìûé SFSFileList()
+  TSFSFileList = class
+  protected
+    fVolume: TSFSVolume;
+
+    function GetCount (): Integer;
+    function GetFiles (index: Integer): TSFSFileInfo;
+
+  public
+    constructor Create (const pVolume: TSFSVolume);
+    destructor Destroy (); override;
+
+    property Count: Integer read GetCount;
+    // ïðè íåïðàâèëüíîì èíäåêñå ìîë÷à âåðí¸ò NIL.
+    // ïðè ïðàâèëüíîì òîæå ìîæåò âåðíóòü NIL!
+    // î÷åíü íå ñîâåòóþ ìåíÿòü ñîäåðæèìîå ïîëó÷åííîãî êëàññà.
+    // êîíå÷íî, ÿ ìîã áû âîçâðàùàòü íîâóþ ñòðóêòóðó èëè íå÷òî ïîõîæåå,
+    // íî áëèí, åñëè òû èäèîò è íå óìååøü äàæå êîììåíòû ÷èòàòü, òî
+    // êàêîãî òû âîîáùå â ïðîãðàììèíã ïîëåç?
+    property Files [index: Integer]: TSFSFileInfo read GetFiles; default;
+  end;
+
+
+procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
+// ýòà ôóíêöèÿ àâòîìàòè÷åñêè ïðèáü¸ò factory.
+procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
+
+// äîáàâèòü ñáîðíèê â ïîñòîÿííûé ñïèñîê.
+// åñëè ñáîðíèê ñ òàêèì èìåíåì óæå îòêðûò, òî íå îòêðûâàåò åãî ïîâòîðíî.
+// íèêîãäà íå êèäàåò èñêëþ÷åíèé.
+// top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
+// âåðí¸ò ëîæü ïðè îøèáêå.
+// ñïîñîáíî îòêðûâàòü ñáîðíèêè â ñáîðíèêàõ ïðè ïîìîùè êðóòûõ èì¸í a-la:
+// "zip:pack0::pack:pack1::wad2:pack2".
+// â äàëüíåéøåì ñëåäóåò îáðàùàòüñÿ ê ñáîðíèêó êàê "pack2::xxx".
+// èëè ìîæíî íàïèñàòü:
+// "zip:pack0::pack:pack1::wad2:pack2|datafile".
+// è îáðàùàòüñÿ êàê "datafile::xxx".
+// "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ.
+// ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà.
+function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean;
+
+// äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds.
+// åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà
+// óãðîáèò ñåé ïîòîê ïî íåîáõîäèìîñòè.
+// virtualName ñòàíîâèòñÿ èìåíåì ñáîðíèêà äëÿ îïåðàöèè îòêðûòèÿ ôàéëà òèïà
+// "packfile:file.ext".
+// åñëè êàêîé-íèáóäü ñáîðíèê ñ èìåíåì virtualName óæå îòêðûò, âåðí¸ò false.
+// íèêîãäà íå êèäàåò èñêëþ÷åíèé.
+// top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
+// âåðí¸ò ëîæü ïðè îøèáêå.
+// îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ.
+// ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå.
+function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean;
+
+// øâûðÿåòñÿ èñêëþ÷åíèÿìè.
+// åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò
+// îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì
+// ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè.
+// åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå.
+function SFSFileOpenEx (const fName: TSFSString): TStream;
+
+// ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé.
+function SFSFileOpen (const fName: TSFSString): TStream;
+
+// âîçâðàùàåò NIL ïðè îøèáêå.
+// ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-)
+function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
+
+function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
+// èãíîðèðóåò ðåãèñòð ñèìâîëîâ
+// <0: s0 < s1
+// =0: s0 = s1
+// >0: s0 > s1
+function SFSStrComp (const s0, s1: TSFSString): Integer;
+
+// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
+// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
+function SFSGetLastVirtualName (const fn: TSFSString): string;
+
+// ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè
+function Int64ToStrComma (i: Int64): string;
+
+// Wildcard matching
+// this code is meant to allow wildcard pattern matches. tt is VERY useful
+// for matching filename wildcard patterns. tt allows unix grep-like pattern
+// comparisons, for instance:
+//
+//       ?       Matches any single characer
+//       +       Matches any single characer or nothing
+//       *       Matches any number of contiguous characters
+//       [abc]   Matches a or b or c at that position
+//       [!abc]  Matches anything but a or b or c at that position
+//       [a-e]   Matches a through e at that position
+//
+//       'ma?ch.*'       -Would match match.exe, mavch.dat, march.on, etc
+//       'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
+//                                 not match 'this as a yest'
+//
+function WildMatch (pattern, text: TSFSString): Boolean;
+function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
+function HasWildcards (const pattern: TSFSString): Boolean;
+
+
+var
+  // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
+  sfsDiskEnabled: Boolean = true;
+  // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå,
+  // ïîòîì â ôàéëàõ äàííûõ.
+  sfsDiskFirst: Boolean = true;
+  // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê
+  // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled).
+  sfsForceDiskForPrefixed: Boolean = false;
+  // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â
+  // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
+  // <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
+  // <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
+  sfsDiskDirs: TSFSString = '<currentdir>|<exedir>';
+
+
+implementation
+
+uses
+  xstreams;
+
+
+function Int64ToStrComma (i: Int64): string;
+var
+  f: Integer;
+begin
+  Str(i, result);
+  f := Length(result)+1;
+  while f > 4 do
+  begin
+    Dec(f, 3); Insert(',', result, f);
+  end;
+end;
+
+
+const
+  // character defines
+  WILD_CHAR_ESCAPE         = '\';
+  WILD_CHAR_SINGLE         = '?';
+  WILD_CHAR_SINGLE_OR_NONE = '+';
+  WILD_CHAR_MULTI          = '*';
+  WILD_CHAR_RANGE_OPEN     = '[';
+  WILD_CHAR_RANGE          = '-';
+  WILD_CHAR_RANGE_CLOSE    = ']';
+  WILD_CHAR_RANGE_NOT      = '!';
+
+
+function HasWildcards (const pattern: TSFSString): Boolean;
+begin
+  result :=
+    (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or
+    (Pos(WILD_CHAR_SINGLE, pattern) <> 0) or
+    (Pos(WILD_CHAR_SINGLE_OR_NONE, pattern) <> 0) or
+    (Pos(WILD_CHAR_MULTI, pattern) <> 0) or
+    (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0);
+end;
+
+function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean;
+var
+  rangeStart, rangeEnd: AnsiChar;
+  rangeNot, rangeMatched: Boolean;
+  ch: AnsiChar;
+begin
+  // sanity checks
+  if (pend < 0) or (pend > Length(pattern)) then pend := Length(pattern);
+  if (tend < 0) or (tend > Length(text)) then tend := Length(text);
+  if t < 1 then t := 1;
+  if p < 1 then p := 1;
+  while p <= pend do
+  begin
+    if t > tend then
+    begin
+      // no more text. check if there's no more chars in pattern (except "*" & "+")
+      while (p <= pend) and
+            ((pattern[p] = WILD_CHAR_MULTI) or
+             (pattern[p] = WILD_CHAR_SINGLE_OR_NONE)) do Inc(p);
+      result := (p > pend);
+      exit;
+    end;
+    case pattern[p] of
+      WILD_CHAR_SINGLE: ;
+      WILD_CHAR_ESCAPE:
+        begin
+          Inc(p);
+          if p > pend then result := false else result := (pattern[p] = text[t]);
+          if not result then exit;
+        end;
+      WILD_CHAR_RANGE_OPEN:
+        begin
+          result := false;
+          Inc(p); if p > pend then exit; // sanity check
+          rangeNot := (pattern[p] = WILD_CHAR_RANGE_NOT);
+          if rangeNot then begin Inc(p); if p > pend then exit; {sanity check} end;
+          if pattern[p] = WILD_CHAR_RANGE_CLOSE then exit; // sanity check
+          ch := text[t]; // speed reasons
+          rangeMatched := false;
+          repeat
+            if p > pend then exit; // sanity check
+            rangeStart := pattern[p];
+            if rangeStart = WILD_CHAR_RANGE_CLOSE then break;
+            Inc(p); if p > pend then exit; // sanity check
+            if pattern[p] = WILD_CHAR_RANGE then
+            begin
+              Inc(p); if p > pend then exit; // sanity check
+              rangeEnd := pattern[p]; Inc(p);
+              if rangeStart < rangeEnd then
+              begin
+                rangeMatched := (ch >= rangeStart) and (ch <= rangeEnd);
+              end
+              else rangeMatched := (ch >= rangeEnd) and (ch <= rangeStart);
+            end
+            else rangeMatched := (ch = rangeStart);
+          until rangeMatched;
+          if rangeNot = rangeMatched then exit;
+
+          // skip the rest or the range
+          while (p <= pend) and (pattern[p] <> WILD_CHAR_RANGE_CLOSE) do Inc(p);
+          if p > pend then exit; // sanity check
+        end;
+      WILD_CHAR_SINGLE_OR_NONE:
+        begin
+          Inc(p);
+          result := MatchMask(pattern, p, pend, text, t, tend);
+          if not result then result := MatchMask(pattern, p, pend, text, t+1, tend);
+          exit;
+        end;
+      WILD_CHAR_MULTI:
+        begin
+          while (p <= pend) and (pattern[p] = WILD_CHAR_MULTI) do Inc(p);
+          result := (p > pend); if result then exit;
+          while not result and (t <= tend) do
+          begin
+            result := MatchMask(pattern, p, pend, text, t, tend);
+            Inc(t);
+          end;
+          exit;
+        end;
+      else result := (pattern[p] = text[t]); if not result then exit;
+    end;
+    Inc(p); Inc(t);
+  end;
+  result := (t > tend);
+end;
+
+
+function WildMatch (pattern, text: TSFSString): Boolean;
+begin
+  if pattern <> '' then pattern := AnsiLowerCase(pattern);
+  if text <> '' then text := AnsiLowerCase(text);
+  result := MatchMask(pattern, 1, -1, text, 1, -1);
+end;
+
+function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
+var
+  s, e: Integer;
+begin
+  if wildList <> '' then wildList := AnsiLowerCase(wildList);
+  if text <> '' then text := AnsiLowerCase(text);
+  result := 0;
+  s := 1;
+  while s <= Length(wildList) do
+  begin
+    e := s; while e <= Length(wildList) do
+    begin
+      if wildList[e] = WILD_CHAR_RANGE_OPEN then
+      begin
+        while (e <= Length(wildList)) and (wildList[e] <> WILD_CHAR_RANGE_CLOSE) do Inc(e);
+      end;
+      if wildList[e] = delimChar then break;
+      Inc(e);
+    end;
+    if s < e then
+    begin
+      if MatchMask(wildList, s, e-1, text, 1, -1) then exit;
+    end;
+    Inc(result);
+    s := e+1;
+  end;
+  result := -1;
+end;
+
+
+type
+  TVolumeInfo = class
+    fFactory: TSFSVolumeFactory;
+    fVolume: TSFSVolume;
+    fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
+    fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
+    fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
+    // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
+    fNoDiskFile: Boolean;
+    fOpenedFilesCount: Integer;
+
+    destructor Destroy (); override;
+  end;
+
+  TOwnedPartialStream = class (TSFSPartialStream)
+  protected
+    fOwner: TVolumeInfo;
+
+  public
+    constructor Create (pOwner: TVolumeInfo; pSrc: TStream; pPos, pSize: Int64; pKillSrc: Boolean);
+    destructor Destroy (); override;
+  end;
+
+
+var
+  factories: TObjectList; // TSFSVolumeFactory
+  volumes: TObjectList;   // TVolumeInfo
+
+
+// ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
+// ñîáñòâåííî èìÿ ôàéëà
+// èìÿ âûãëÿäèò êàê:
+// (("sfspfx:")?"datafile::")*"filename"
+procedure SplitFName (const fn: string; out dataFile, fileName: string);
+var
+  f: Integer;
+begin
+  f := Length(fn)-1;
+  while f >= 1 do
+  begin
+    if (fn[f] = ':') and (fn[f+1] = ':') then break;
+    Dec(f);
+  end;
+  if f < 1 then begin dataFile := ''; fileName := fn; end
+  else
+  begin
+    dataFile := Copy(fn, 1, f-1);
+    fileName := Copy(fn, f+2, maxInt-10000);
+  end;
+end;
+
+// ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
+function ExtractVirtName (var dataFile: string): string;
+var
+  f: Integer;
+begin
+  f := Length(dataFile); result := dataFile;
+  while f > 1 do
+  begin
+    if dataFile[f] = ':' then break;
+    if dataFile[f] = '|' then
+    begin
+      if dataFile[f-1] = '|' then begin Dec(f); Delete(dataFile, f, 1); end
+      else
+      begin
+        result := Copy(dataFile, f+1, Length(dataFile));
+        Delete(dataFile, f, Length(dataFile));
+        break;
+      end;
+    end;
+    Dec(f);
+  end;
+end;
+
+// ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
+// âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile.
+// èìÿ âûãëÿäèò êàê:
+// [sfspfx:]datafile[|virtname]
+// åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
+// à èìåíåì äèñêà.
+procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string);
+var
+  f: Integer;
+begin
+  f := Pos(':', fn);
+  if f <= 3 then begin pfx := ''; dataFile := fn; end
+  else
+  begin
+    pfx := Copy(fn, 1, f-1);
+    dataFile := Copy(fn, f+1, maxInt-10000);
+  end;
+  virtName := ExtractVirtName(dataFile);
+end;
+
+// íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
+// onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
+function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer;
+var
+  f: Integer;
+  vi: TVolumeInfo;
+begin
+  f := 0;
+  while f < volumes.Count do
+  begin
+    if volumes[f] <> nil then
+    begin
+      vi := TVolumeInfo(volumes[f]);
+      if not onlyPerm or vi.fPermanent then
+      begin
+        if SFSStrComp(vi.fPackName, dataFileName) = 0 then
+        begin
+          result := f;
+          exit;
+        end;
+      end;
+    end;
+    Inc(f);
+  end;
+  result := -1;
+end;
+
+// íàéòè èíôó äëÿ ýòîãî òîìà.
+// õîðîøåå èìÿ, ïðàâäà? %-)
+function FindVolumeInfoByVolumeInstance (vol: TSFSVolume): Integer;
+begin
+  result := volumes.Count-1;
+  while result >= 0 do
+  begin
+    if volumes[result] <> nil then
+    begin
+      if TVolumeInfo(volumes[result]).fVolume = vol then exit;
+    end;
+    Dec(result);
+  end;
+end;
+
+// <0: s0 < s1
+// =0: s0 = s1
+// >0: s0 > s1
+function SFSStrComp (const s0, s1: TSFSString): Integer;
+begin
+  result := AnsiCompareText(s0, s1);
+end;
+
+function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
+var
+  f: Integer;
+begin
+  result := s;
+  for f := 1 to Length(result) do
+  begin
+    if (result[f] = '/') or (result[f] = '\') then
+    begin
+      // avoid unnecessary string changes
+      if result[f] <> newDelim then result[f] := newDelim;
+    end;
+  end;
+end;
+
+function SFSGetLastVirtualName (const fn: TSFSString): string;
+var
+  rest, tmp: string;
+  f: Integer;
+begin
+  rest := fn;
+  repeat
+    f := Pos('::', rest); if f = 0 then f := Length(rest)+1;
+    tmp := Copy(rest, 1, f-1); Delete(rest, 1, f+1);
+    result := ExtractVirtName(tmp);
+  until rest = '';
+end;
+
+
+{ TVolumeInfo }
+destructor TVolumeInfo.Destroy ();
+var
+  f, me: Integer;
+  used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
+begin
+  if fFactory <> nil then fFactory.Recycle(fVolume);
+  fVolume := nil; fFactory := nil; fPackName := '';
+
+  // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ,
+  // òî óãðîáèòü åãî íàôèã.
+  me := volumes.IndexOf(self);
+  used := false;
+  f := volumes.Count-1;
+  while not used and (f >= 0) do
+  begin
+    if (f <> me) and (volumes[f] <> nil) then
+    begin
+      used := (TVolumeInfo(volumes[f]).fStream = fStream);
+      if not used then
+        used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream);
+    end;
+    Dec(f);
+  end;
+  if not used then FreeAndNil(fStream); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì
+  inherited Destroy();
+end;
+
+
+{ TOwnedPartialStream }
+constructor TOwnedPartialStream.Create (pOwner: TVolumeInfo; pSrc: TStream;
+  pPos, pSize: Int64; pKillSrc: Boolean);
+begin
+  inherited Create(pSrc, pPos, pSize, pKillSrc);
+  fOwner := pOwner;
+  if pOwner <> nil then Inc(pOwner.fOpenedFilesCount);
+end;
+
+destructor TOwnedPartialStream.Destroy ();
+var
+  f: Integer;
+begin
+  inherited Destroy();
+  if fOwner <> nil then
+  begin
+    Dec(fOwner.fOpenedFilesCount);
+    if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then
+    begin
+      f := volumes.IndexOf(fOwner);
+      if f <> -1 then volumes[f] := nil; // this will destroy the volume
+    end;
+  end;
+end;
+
+
+{ TSFSFileInfo }
+constructor TSFSFileInfo.Create (pOwner: TSFSVolume);
+begin
+  inherited Create();
+  fOwner := pOwner;
+  fPath := ''; fName := '';
+  fSize := 0; fOfs := 0;
+  if pOwner <> nil then pOwner.fFiles.Add(self);
+end;
+
+destructor TSFSFileInfo.Destroy ();
+begin
+  if fOwner <> nil then fOwner.fFiles.Extract(self);
+  inherited Destroy();
+end;
+
+
+{ TSFSVolume }
+constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream);
+begin
+  inherited Create();
+  fFileStream := pSt;
+  fFileName := pFileName;
+  fFiles := TObjectList.Create(true);
+end;
+
+procedure TSFSVolume.DoDirectoryRead ();
+var
+  fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so!
+  f, c, n: Integer;
+  sfi: TSFSFileInfo;
+  tmp, fn, ext: TSFSString;
+begin
+  fl := nil;
+  fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
+  try
+    ReadDirectory();
+    fFiles.Pack();
+
+    // check for duplicate file names
+    fl := TStringList.Create(); fl.Sorted := true;
+    for f := 0 to fFiles.Count-1 do
+    begin
+      sfi := TSFSFileInfo(fFiles[f]);
+
+      // normalize name & path
+      sfi.fPath := SFSReplacePathDelims(sfi.fPath, '/');
+      if (sfi.fPath <> '') and (sfi.fPath[1] = '/') then Delete(sfi.fPath, 1, 1);
+      if (sfi.fPath <> '') and (sfi.fPath[Length(sfi.fPath)] <> '/') then sfi.fPath := sfi.fPath+'/';
+      tmp := SFSReplacePathDelims(sfi.fName, '/');
+      c := Length(tmp); while (c > 0) and (tmp[c] <> '/') do Dec(c);
+      if c > 0 then
+      begin
+        // split path and name
+        Delete(sfi.fName, 1, c); // cut name
+        tmp := Copy(tmp, 1, c);  // get path
+        if tmp = '/' then tmp := ''; // just delimiter; ignore it
+        sfi.fPath := sfi.fPath+tmp;
+      end;
+
+      // check for duplicates
+      if fl.Find(sfi.fPath+sfi.fName, c) then
+      begin
+        n := 0; tmp := sfi.fName;
+        c := Length(tmp); while (c > 0) and (tmp[c] <> '.') do Dec(c);
+        if c < 1 then c := Length(tmp)+1;
+        fn := Copy(tmp, 1, c-1); ext := Copy(tmp, c, Length(tmp));
+        repeat
+          tmp := fn+'_'+IntToStr(n)+ext;
+          if not fl.Find(sfi.fPath+tmp, c) then break;
+          Inc(n);
+        until false;
+        sfi.fName := tmp;
+      end;
+      fl.Add(sfi.fName);
+    end;
+    fl.Free();
+  except
+    fl.Free();
+    raise;
+  end;
+end;
+
+destructor TSFSVolume.Destroy ();
+begin
+  Clear();
+  FreeAndNil(fFiles);
+  inherited Destroy();
+end;
+
+procedure TSFSVolume.Clear ();
+begin
+  fFiles.Clear();
+end;
+
+function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer;
+begin
+  if fFiles = nil then result := -1
+  else
+  begin
+    result := fFiles.Count;
+    while result > 0 do
+    begin
+      Dec(result);
+      if fFiles[result] <> nil then
+      begin
+        if (SFSStrComp(fPath, TSFSFileInfo(fFiles[result]).fPath) = 0) and
+           (SFSStrComp(fName, TSFSFileInfo(fFiles[result]).fName) = 0) then exit;
+      end;
+    end;
+    result := -1;
+  end;
+end;
+
+function TSFSVolume.GetFileCount (): Integer;
+begin
+  if fFiles = nil then result := 0 else result := fFiles.Count;
+end;
+
+function TSFSVolume.GetFiles (index: Integer): TSFSFileInfo;
+begin
+  if fFiles = nil then result := nil
+  else
+  begin
+    if (index < 0) or (index >= fFiles.Count) then result := nil
+    else result := TSFSFileInfo(fFiles[index]);
+  end;
+end;
+
+function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream;
+var
+  fp, fn: TSFSString;
+  f, ls: Integer;
+begin
+  fp := fName;
+  // normalize name, find split position
+  if (fp <> '') and ((fp[1] = '/') or (fp[1] = '\')) then Delete(fp, 1, 1);
+  ls := 0;
+  for f := 1 to Length(fp) do
+  begin
+    if fp[f] = '\' then fp[f] := '/';
+    if fp[f] = '/' then ls := f;
+  end;
+  fn := Copy(fp, ls+1, Length(fp));
+  fp := Copy(fp, 1, ls);
+  f := FindFile(fp, fn);
+  if f = -1 then raise ESFSError.Create('file not found: "'+fName+'"');
+  result := OpenFileByIndex(f);
+  if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
+end;
+
+
+{ TSFSFileList }
+constructor TSFSFileList.Create (const pVolume: TSFSVolume);
+var
+  f: Integer;
+begin
+  inherited Create();
+  ASSERT(pVolume <> nil);
+  f := FindVolumeInfoByVolumeInstance(pVolume);
+  ASSERT(f <> -1);
+  fVolume := pVolume;
+  Inc(TVolumeInfo(volumes[f]).fOpenedFilesCount); // íå ïîçâîëèì óáèòü çàïèñü!
+end;
+
+destructor TSFSFileList.Destroy ();
+var
+  f: Integer;
+begin
+  f := FindVolumeInfoByVolumeInstance(fVolume);
+  ASSERT(f <> -1);
+  Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
+  // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
+  if not TVolumeInfo(volumes[f]).fPermanent and
+     (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then volumes[f] := nil;
+  inherited Destroy();
+end;
+
+function TSFSFileList.GetCount (): Integer;
+begin
+  result := fVolume.fFiles.Count;
+end;
+
+function TSFSFileList.GetFiles (index: Integer): TSFSFileInfo;
+begin
+  if (index < 0) or (index >= fVolume.fFiles.Count) then result := nil
+  else result := TSFSFileInfo(fVolume.fFiles[index]);
+end;
+
+
+procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
+var
+  f: Integer;
+begin
+  if factory = nil then exit;
+  if factories.IndexOf(factory) <> -1 then
+    raise ESFSError.Create('duplicate factories are not allowed');
+  f := factories.IndexOf(nil);
+  if f = -1 then factories.Add(factory) else factories[f] := factory;
+end;
+
+procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
+var
+  f: Integer;
+  c: Integer;
+begin
+  if factory = nil then exit;
+  f := factories.IndexOf(factory);
+  if f = -1 then raise ESFSError.Create('can''t unregister nonexisting factory');
+  c := 0; while c < volumes.Count do
+  begin
+    if (volumes[c] <> nil) and (TVolumeInfo(volumes[c]).fFactory = factory) then volumes[c] := nil;
+    Inc(c);
+  end;
+  factories[f] := nil;
+end;
+
+
+function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream;
+  top, permanent: Integer): Integer;
+// dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
+// ìîæåò âûêèíóòü èñêëþ÷åíèå!
+// top:
+//   <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
+//   =0: íå ìåíÿòü.
+//   >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà.
+// permanent:
+//   <0: ñîçäàòü "âðåìåííûé" òîì.
+//   =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà.
+//   >0: ñîçäàòü "ïîñòîÿííûé" òîì.
+// åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì
+// dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã.
+// âîçâðàùàåò èíäåêñ â volumes.
+// óìååò äåëàòü ðåêóðñèþ.
+var
+  fac: TSFSVolumeFactory;
+  vol: TSFSVolume;
+  vi: TVolumeInfo;
+  f: Integer;
+  st, st1: TStream;
+  pfx: TSFSString;
+  fn, vfn, tmp: TSFSString;
+begin
+  f := Pos('::', dataFileName);
+  if f <> 0 then
+  begin
+    // ðåêóðñèâíîå îòêðûòèå.
+    // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê.
+    // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì.
+    pfx := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f+1);
+    // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê...
+    result := SFSAddDataFileEx(pfx, ds, 0, 0);
+    // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì.
+    // óçíàåì, êàêîå ôàéëî îòêðûâàòü.
+    // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà).
+    f := Pos('::', dataFileName); if f = 0 then f := Length(dataFileName)+1;
+    fn := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f-1);
+    // dataFileName õðàíèò îñòàòîê.
+    // èçâëå÷¸ì èìÿ ôàéëà:
+    SplitDataName(fn, pfx, tmp, vfn);
+    // îòêðîåì ýòîò ôàéë
+    vi := TVolumeInfo(volumes[result]); st := nil;
+    try
+      st := vi.fVolume.OpenFileEx(tmp);
+      st1 := TOwnedPartialStream.Create(vi, st, 0, st.Size, true);
+    except
+      FreeAndNil(st);
+      // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì.
+      if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil;
+      raise;
+    end;
+    // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå.
+    fn := fn+dataFileName;
+    try
+      st1.Position := 0;
+      result := SFSAddDataFileEx(fn, st1, top, permanent);
+    except
+      st1.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè.
+      raise;
+    end;
+    exit;
+  end;
+
+  // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå.
+  SplitDataName(dataFileName, pfx, fn, vfn);
+
+  f := FindVolumeInfo(vfn);
+  if f <> -1 then
+  begin
+    if ds <> nil then raise ESFSError.Create('subdata name conflict');
+    if permanent <> 0 then TVolumeInfo(volumes[f]).fPermanent := (permanent > 0);
+    if top = 0 then result := f
+    else if top < 0 then result := 0
+    else result := volumes.Count-1;
+    if result <> f then volumes.Move(f, result);
+    exit;
+  end;
+
+  if ds <> nil then st := ds
+  else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
+  st.Position := 0;
+
+  volumes.Pack();
+
+  fac := nil; vol := nil;
+  try
+    for f := 0 to factories.Count-1 do
+    begin
+      fac := TSFSVolumeFactory(factories[f]);
+      if fac = nil then continue;
+      if (pfx <> '') and not fac.IsMyVolumePrefix(pfx) then continue;
+      st.Position := 0;
+      try
+        if ds <> nil then vol := fac.Produce(pfx, '', st)
+        else vol := fac.Produce(pfx, fn, st);
+      except
+        vol := nil;
+      end;
+      if vol <> nil then break;
+    end;
+    if vol = nil then raise ESFSError.Create('no factory for "'+dataFileName+'"');
+  except
+    if st <> ds then st.Free();
+    raise;
+  end;
+
+  vi := TVolumeInfo.Create();
+  try
+    if top < 0 then
+    begin
+      result := 0;
+      volumes.Insert(0, vi);
+    end
+    else result := volumes.Add(vi);
+  except
+    vol.Free();
+    if st <> ds then st.Free();
+    vi.Free();
+    raise;
+  end;
+
+  vi.fFactory := fac;
+  vi.fVolume := vol;
+  vi.fPackName := vfn;
+  vi.fStream := st;
+  vi.fPermanent := (permanent > 0);
+  vi.fNoDiskFile := (ds <> nil);
+  vi.fOpenedFilesCount := 0;
+end;
+
+function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream;
+  top: Boolean = false): Boolean;
+var
+  tv: Integer;
+begin
+  ASSERT(ds <> nil);
+  try
+    if top then tv := -1 else tv := 1;
+    SFSAddDataFileEx(virtualName, ds, tv, 0);
+    result := true;
+  except
+    result := false;
+  end;
+end;
+
+function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean = false): Boolean;
+var
+  tv: Integer;
+begin
+  try
+    if top then tv := -1 else tv := 1;
+    SFSAddDataFileEx(dataFileName, nil, tv, 1);
+    result := true;
+  except
+    result := false;
+  end;
+end;
+
+
+function SFSExpandDirName (const s: TSFSString): TSFSString;
+var
+  f, e: Integer;
+  es: TSFSString;
+begin
+  f := 1; result := s;
+  while f < Length(result) do
+  begin
+    while (f < Length(result)) and (result[f] <> '<') do Inc(f);
+    if f >= Length(result) then exit;
+    e := f; while (e < Length(result)) and (result[e] <> '>') do Inc(e);
+    es := Copy(result, f, e+1-f);
+
+    if es = '<currentdir>' then es := GetCurrentDir
+    else if es = '<exedir>' then es := ExtractFilePath(ParamStr(0))
+    else es := '';
+
+    if es <> '' then
+    begin
+      if (es[Length(es)] <> '/') and (es[Length(es)] <> '\') then es := es+'/';
+      Delete(result, f, e+1-f);
+      Insert(es, result, f);
+      Inc(f, Length(es));
+    end
+    else f := e+1;
+  end;
+end;
+
+function SFSFileOpenEx (const fName: TSFSString): TStream;
+var
+  dataFileName, fn: TSFSString;
+  f: Integer;
+  vi: TVolumeInfo;
+  diskChecked: Boolean;
+  ps: TStream;
+
+  function CheckDisk (): TStream;
+  // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
+  var
+    dfn, dirs, cdir: TSFSString;
+    f: Integer;
+  begin
+    result := nil;
+    if diskChecked or not sfsDiskEnabled then exit;
+    diskChecked := true;
+    dfn := SFSReplacePathDelims(fn, '/');
+    dirs := sfsDiskDirs; if dirs = '' then dirs := '<currentdir>';
+    while dirs <> '' do
+    begin
+      f := 1; while (f <= Length(dirs)) and (dirs[f] <> '|') do Inc(f);
+      cdir := Copy(dirs, 1, f-1); Delete(dirs, 1, f);
+      if cdir = '' then continue;
+      cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/');
+      if cdir[Length(cdir)] <> '/' then cdir := cdir+'/';
+      try
+        result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite);
+        exit;
+      except
+      end;
+    end;
+  end;
+
+begin
+  SplitFName(fName, dataFileName, fn);
+  if fn = '' then raise ESFSError.Create('invalid file name: "'+fName+'"');
+
+  diskChecked := false;
+
+  if dataFileName <> '' then
+  begin
+    // ïðåôèêñîâàíûé ôàéë
+    if sfsForceDiskForPrefixed then
+    begin
+      result := CheckDisk();
+      if result <> nil then exit;
+    end;
+
+    f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
+    vi := TVolumeInfo(volumes[f]);
+
+    try
+      result := vi.fVolume.OpenFileEx(fn);
+      ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
+    except
+      result.Free();
+      if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
+      result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê
+      if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
+      exit;
+    end;
+    //Inc(vi.fOpenedFilesCount);
+    result := ps;
+    exit;
+  end;
+
+  // íåïðåôèêñîâàíûé ôàéë
+  if sfsDiskFirst then
+  begin
+    result := CheckDisk();
+    if result <> nil then exit;
+  end;
+  // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì
+  f := 0;
+  while f < volumes.Count do
+  begin
+    vi := TVolumeInfo(volumes[f]);
+    if (vi <> nil) and vi.fPermanent then
+    begin
+      if vi.fVolume <> nil then
+      begin
+        result := vi.fVolume.OpenFileEx(fn);
+        if result <> nil then
+        begin
+          try
+            ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
+            result := ps;
+            //Inc(vi.fOpenedFilesCount);
+          except
+            FreeAndNil(result);
+          end;
+        end;
+        if result <> nil then exit;
+      end;
+    end;
+    Inc(f);
+  end;
+  result := CheckDisk();
+  if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
+end;
+
+function SFSFileOpen (const fName: TSFSString): TStream;
+begin
+  try
+    result := SFSFileOpenEx(fName);
+  except
+    result := nil;
+  end;
+end;
+
+function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
+var
+  f: Integer;
+  vi: TVolumeInfo;
+begin
+  result := nil;
+  if dataFileName = '' then exit;
+
+  try
+    f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
+  except
+    exit;
+  end;
+  vi := TVolumeInfo(volumes[f]);
+
+  try
+    result := TSFSFileList.Create(vi.fVolume);
+  except
+    if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
+  end;
+end;
+
+
+initialization
+  factories := TObjectList.Create(true);
+  volumes := TObjectList.Create(true);
+finalization
+  //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?!
+  //factories.Free(); // not need to be done actually...
+end.

diff --git a/src/sfs/sfsMemFS.pas b/src/sfs/sfsMemFS.pas
new file mode 100644 (file)
index 0000000..f3fcf0b
--- /dev/null
+++ b/src/sfs/sfsMemFS.pas
@@ -0,0 +1,241 @@
+// Streaming R/O Virtual File System v0.2.0
+// Copyright (C) XL A.S. Ketmar.  All rights reserved
+// See the file aplicense.txt for conditions of use.
+//
+// "memory group". reads the whole pack in memory (and decompress it if
+// necessary). memory image has only one file named "<body>".
+//
+// now understands:
+//   slh!: DOS Allegro "slh!"
+//   mem : raw file (no processing, just read)
+//     as a side effect this gives us an opportunity to read enclosed packs
+//     from the packs which aren't supporting backseeking (such as zips).
+//
+{$MODE DELPHI}
+{.$R-}
+unit sfsMemFS;
+
+interface
+
+uses
+  SysUtils, Classes, Contnrs, sfs;
+
+
+type
+  TSFSMemVolumeType = (sfsmvNone, sfsmvRAW, sfsmvSLH);
+
+  TSFSMemoryVolume = class(TSFSVolume)
+  protected
+    fType: TSFSMemVolumeType;
+    fMemStream: TMemoryStream;
+
+    procedure RAWRead ();
+    procedure SLHRead ();
+
+    procedure ReadDirectory (); override;
+    function OpenFileByIndex (const index: Integer): TStream; override;
+  end;
+
+  TSFSMemoryVolumeFactory = class (TSFSVolumeFactory)
+  public
+    function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
+    function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
+    procedure Recycle (vol: TSFSVolume); override;
+  end;
+
+
+
+implementation
+
+uses
+  xstreams;
+
+
+function SLHCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.Seek(-4, soCurrent);
+  if sign <> 'slh!' then exit;
+  result := true;
+end;
+
+
+{ TSFSMemoryVolume }
+procedure TSFSMemoryVolume.RAWRead ();
+var
+  fi: TSFSFileInfo;
+begin
+  fMemStream.CopyFrom(fFileStream, 0); // voila %-)
+  fi := TSFSFileInfo.Create(self);
+  fi.fName := '<body>';
+  fi.fSize := fMemStream.Size;
+end;
+
+procedure TSFSMemoryVolume.SLHRead ();
+// unpack LZSS-packed file
+var
+  fi: TSFSFileInfo;
+  bufi, bufo: packed array of Byte;
+  iused, oused, rpos: Integer;
+  dict: packed array of Byte;
+  flags, dpos, pos, len: Word;
+  c: Integer;
+
+  function ReadCh (): Integer;
+  begin
+    if rpos >= iused then
+    begin
+      // int64!
+      if fFileStream.Size-fFileStream.Position > Length(bufi) then iused := Length(bufi)
+      else iused := fFileStream.Size-fFileStream.Position;
+      rpos := 0;
+      if iused > 0 then fFileStream.ReadBuffer(bufi[0], iused);
+    end;
+
+    if iused = 0 then result := -1
+    else begin result := bufi[rpos]; Inc(rpos); end;
+  end;
+
+  procedure WriteCh (c: Byte);
+  begin
+    if oused >= Length(bufo) then
+    begin
+      fMemStream.WriteBuffer(bufo[0], oused);
+      oused := 0;
+    end;
+    bufo[oused] := c; Inc(oused);
+    dict[dpos] := c; dpos := (dpos+1) and $FFF;
+  end;
+
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  SetLength(bufi, 65536); SetLength(bufo, 65536); SetLength(dict, 4096);
+  rpos := 0; iused := 0; oused := 0;
+  flags := 0; dpos := 4096-18;
+  repeat
+    if (flags and $FF00) = 0 then
+    begin
+      c := ReadCh(); if c = -1 then break;
+      flags := c or $FF00;
+    end;
+
+    if (flags and $01) <> 0 then
+    begin
+      // literal
+      c := ReadCh(); if c = -1 then break;
+      WriteCh(c);
+    end
+    else
+    begin
+      // "copy"
+      c := ReadCh(); if c = -1 then break;
+      pos := c;
+      c := ReadCh(); if c = -1 then break;
+      len := c;
+      pos := (pos and $FF) or ((len and $F0) shl 4); len := (len and $0F)+3;
+      while len > 0 do
+      begin
+        c := dict[pos]; pos := (pos+1) and $FFF; Dec(len);
+        WriteCh(c);
+      end;
+    end;
+    flags := flags shr 1;
+  until false;
+  if oused > 0 then fMemStream.WriteBuffer(bufo[0], oused);
+
+  fi := TSFSFileInfo.Create(self);
+  fi.fName := '<body>';
+  fi.fSize := fMemStream.Size;
+end;
+
+procedure TSFSMemoryVolume.ReadDirectory ();
+begin
+  if fMemStream = nil then fMemStream := TMemoryStream.Create()
+  else
+  begin
+    fMemStream.Position := 0; fMemStream.Size := 0;
+  end;
+
+  case fType of
+    sfsmvSLH: SLHRead();
+    sfsmvRAW: RAWRead();
+    else raise ESFSError.Create('invalid memory SFS');
+  end;
+
+  fMemStream.Position := 0;
+end;
+
+function TSFSMemoryVolume.OpenFileByIndex (const index: Integer): TStream;
+var
+  fs: TStream;
+begin
+  result := nil; fs := nil;
+  if fFiles = nil then exit;
+  if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
+
+  try
+    fs := TSFSMemoryStreamRO.Create(fMemStream.Memory, fMemStream.Size);
+    if fFiles.Count = 1 then
+    begin
+      result := fs;
+    end
+    else
+    begin
+      try
+        result := TSFSPartialStream.Create(fs,
+          TSFSFileInfo(fFiles[index]).fOfs,
+          TSFSFileInfo(fFiles[index]).fSize, true);
+      except
+        FreeAndNil(fs);
+        raise;
+      end;
+    end;
+  except
+    result := nil;
+  end;
+end;
+
+
+{ TSFSMemoryVolumeFactory }
+function TSFSMemoryVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+begin
+  result :=
+    (SFSStrComp(prefix, 'mem') = 0) or
+    (SFSStrComp(prefix, 'slh!') = 0);
+end;
+
+procedure TSFSMemoryVolumeFactory.Recycle (vol: TSFSVolume);
+begin
+  vol.Free();
+end;
+
+function TSFSMemoryVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
+var
+  vt: TSFSMemVolumeType;
+begin
+  if (prefix <> 'mem') and SLHCheckMagic(st) then vt := sfsmvSLH
+  else if prefix <> '' then vt := sfsmvRAW
+  else vt := sfsmvNone;
+
+  result := TSFSMemoryVolume.Create(fileName, st);
+  TSFSMemoryVolume(result).fType := vt;
+  try
+    result.DoDirectoryRead();
+  except
+    FreeAndNil(result);
+    raise;
+  end;
+end;
+
+
+var
+  memf: TSFSMemoryVolumeFactory;
+initialization
+  memf := TSFSMemoryVolumeFactory.Create();
+  SFSRegisterVolumeFactory(memf);
+finalization
+  SFSUnregisterVolumeFactory(memf);
+end.

diff --git a/src/sfs/sfsPlainFS.pas b/src/sfs/sfsPlainFS.pas
new file mode 100644 (file)
index 0000000..54438f0
--- /dev/null
+++ b/src/sfs/sfsPlainFS.pas
@@ -0,0 +1,726 @@
+// Streaming R/O Virtual File System v0.2.0
+// Copyright (C) XL A.S. Ketmar.  All rights reserved
+// See the file aplicense.txt for conditions of use.
+//
+// simple grouping files w/o packing:
+//   wad, doom       : DooM .WAD (IWAD, PWAD)
+//   pak, quake      : Quake I/II .PAK (PACK)
+//   grp, duke3d     : Duke3D .GRP (KenSilverman)
+//   spe, spec, abuse: Abuse .SPE (SPEC1.0)
+//   wad2            : Quake .WAD (WAD2)
+//   allegro         : DOS Allegro (slh.ALL.; ALL.)
+//   dune2 pak       : alas, no signature %-(
+//   M.A.X. res      : RES0
+//   sin             : SiN .SIN (SPAK)
+//
+{.$DEFINE SFS_PLAIN_FS_ALTERNATIVE_SPEC}
+  // define this and the first byte of each file in .SPE will contain
+  // file type.
+  // undefine this and file type will be directory name.
+{.$DEFINE SFS_PLAIN_FS_DEBUG_ALLEGRO}
+{$MODE DELPHI}
+{.$R-}
+unit sfsPlainFS;
+
+interface
+
+uses
+  SysUtils, Classes, Contnrs, sfs;
+
+
+
+type
+  TSFSPlainVolumeType =
+    (sfspvNone, sfspvWAD, sfspvPAK, sfspvGRP, sfspvSPE, sfspvWAD2, sfspvALL,
+     sfspvDune2, sfspvMAX, sfspvSIN);
+
+  TSFSPlainVolume = class (TSFSVolume)
+  protected
+    fType: TSFSPlainVolumeType;
+
+    procedure PAKReadDirectory ();
+    procedure WADReadDirectory ();
+    procedure GRPReadDirectory ();
+    procedure SPEReadDirectory ();
+    procedure WAD2ReadDirectory ();
+    procedure ALLReadDirectory ();
+    procedure Dune2ReadDirectory ();
+    procedure MAXReadDirectory ();
+    procedure SINReadDirectory ();
+
+    procedure ReadDirectory (); override;
+    function OpenFileByIndex (const index: Integer): TStream; override;
+  end;
+
+  TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
+  public
+    function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
+    function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
+    procedure Recycle (vol: TSFSVolume); override;
+  end;
+
+
+
+implementation
+
+uses
+  xstreams;
+
+
+type
+  TSFSExtFileInfo = class (TSFSFileInfo)
+  public
+    fVBuf: packed array of Byte;
+    fLink: TSFSString;
+  end;
+
+  TAllegroProperty = class
+    name: TSFSString;
+    ofs: Int64;
+    size: Integer;
+  end;
+
+
+function ReadMD (st: TStream): Integer;
+// read dword in big-endian format. portable.
+var
+  buf: packed array [0..3] of Byte;
+begin
+  st.ReadBuffer(buf[0], 4);
+  result := (buf[0] shl 24) or (buf[1] shl 16) or (buf[2] shl 8) or buf[3];
+end;
+
+function WADCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  fcnt, dofs: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
+  st.Seek(-12, soCurrent);
+  if (sign <> 'IWAD') and (sign <> 'PWAD') then exit;
+  if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
+     (dofs+fcnt*16 > st.Size) then exit;
+  result := true;
+end;
+
+function PAKCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  dsize, dofs: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
+  st.Seek(-12, soCurrent);
+  if sign <> 'PACK' then exit;
+  if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
+     (dsize mod 64 <> 0) then exit;
+  result := true;
+end;
+
+function SINCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  dsize, dofs: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4);
+  st.Seek(-12, soCurrent);
+  if sign <> 'SPAK' then exit;
+  if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or
+     (dsize mod 64 <> 0) then exit;
+  result := true;
+end;
+
+function GRPCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..11] of Char;
+  fcnt: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 12);
+  st.ReadBuffer(fcnt, 4);
+  st.Seek(-16, soCurrent);
+  if sign <> 'KenSilverman' then exit;
+  if (fcnt < 0) or (fcnt*16 > st.Size-16) then exit;
+  result := true;
+end;
+
+function SPECheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..6] of Char;
+  b: Byte;
+  fcnt: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 7); st.ReadBuffer(b, 1);
+  st.ReadBuffer(fcnt, 4);
+  st.Seek(-12, soCurrent);
+  if (sign <> 'SPEC1.0') or (b <> 0) or (fcnt < 0) then exit;
+  result := true;
+end;
+
+function WAD2CheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  fcnt, dofs: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
+  st.Seek(-12, soCurrent);
+  if sign <> 'WAD2' then exit;
+  if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
+     (dofs+fcnt*32 > st.Size) then exit;
+  result := true;
+end;
+
+function ALLCheckMagic (st: TStream): Boolean;
+var
+  sign0, sign1: packed array [0..3] of Char;
+begin
+  result := false;
+  st.ReadBuffer(sign0[0], 4);
+  st.ReadBuffer(sign1[0], 4);
+  st.Seek(-8, soCurrent);
+  if sign0 = 'slh.' then
+  begin
+    if sign1 <> 'ALL.' then exit;
+  end else if sign0 <> 'ALL.' then exit;
+  result := true;
+end;
+
+function Dune2CheckMagic (st: TStream): Boolean;
+var
+  cpos, np, f: Integer;
+begin
+  cpos := st.Position;
+  st.ReadBuffer(np, 4);
+  st.Position := np-4;
+  st.ReadBuffer(f, 4);
+  st.Position := cpos;
+  result := (f = 0);
+end;
+
+function MAXCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  fcnt, dofs: Integer;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(dofs, 4); st.ReadBuffer(fcnt, 4);
+  st.Seek(-12, soCurrent);
+  if sign <> 'RES0' then exit;
+  if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or
+     (dofs+fcnt > st.Size) then exit;
+  result := true;
+end;
+
+
+{ TSFSPlainVolume }
+procedure TSFSPlainVolume.WADReadDirectory ();
+var
+  fcnt: LongWord;
+  dofs: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..9] of Char;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 4);
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.Position := dofs;
+  while fcnt <> 0 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 8);
+    fi.fName := PChar(@name[0]);
+    Dec(fcnt);
+  end;
+end;
+
+procedure TSFSPlainVolume.PAKReadDirectory ();
+var
+  dsize, dofs: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..56] of Char;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.ReadBuffer(dsize, 4);
+  fFileStream.Position := dofs;
+  while dsize >= 64 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 56);
+    fi.fName := PChar(@name[0]);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    Dec(dsize, 64);
+  end;
+end;
+
+procedure TSFSPlainVolume.SINReadDirectory ();
+var
+  dsize, dofs: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..120] of Char;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.ReadBuffer(dsize, 4);
+  fFileStream.Position := dofs;
+  while dsize >= 128 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 120);
+    fi.fName := PChar(@name[0]);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    Dec(dsize, 128);
+  end;
+end;
+
+procedure TSFSPlainVolume.GRPReadDirectory ();
+var
+  fcnt: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..12] of Char;
+  ofs: Int64;
+begin
+  fFileStream.Seek(12, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 4);
+  ofs := fFileStream.Position+fcnt*16;
+  while fcnt <> 0 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    fi.fOfs := ofs;
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 12);
+    fi.fName := PChar(@name[0]);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    Inc(ofs, fi.fSize);
+    Dec(fcnt);
+  end;
+end;
+
+procedure TSFSPlainVolume.SPEReadDirectory ();
+var
+  fcnt: Word;
+  fi: TSFSExtFileInfo;
+  {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
+  pp: TSFSString;
+  {$ENDIF}
+  name: ShortString;
+  f, c: Integer;
+  b: Byte;
+  wasUnfixedLink: Boolean;
+begin
+  fFileStream.Seek(8, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 2);
+  while fcnt <> 0 do
+  begin
+    fi := TSFSExtFileInfo.Create(self);
+   {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
+    SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1);
+   {$ELSE}
+     SetLength(fi.fVBuf, 0);
+    fFileStream.ReadBuffer(b, 1);
+    pp := IntToHex(b, 2)+'/';
+   {$ENDIF}
+    fFileStream.ReadBuffer(name[0], 1);
+    if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
+    f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
+    fi.fName := SFSReplacePathDelims(name, '/');
+    if fi.fName = '' then fi.fName := 'untitled_file';
+    if fi.fName[1] = '/' then Delete(fi.fName, 1, 1);
+   {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
+    fi.fName := pp+fi.fName;
+   {$ENDIF}
+    fFileStream.ReadBuffer(b, 1);
+    if (b and $01) <> 0 then
+    begin
+      // link
+      fFileStream.ReadBuffer(name[0], 1);
+      if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name));
+      f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
+      if name[0] = #0 then name := #0;
+      fi.fLink := name;
+    end
+    else
+    begin
+      fi.fLink := '';
+      fFileStream.ReadBuffer(fi.fSize, 4);
+     {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC}
+      Inc(fi.fSize); // plus type byte
+     {$ENDIF}
+      fFileStream.ReadBuffer(fi.fOfs, 4);
+    end;
+    Dec(fcnt);
+  end;
+
+  // now fixup links
+  // nobody uses this shit, but it was documented by JC. %-)
+  // i even allow links to links! %-)
+  wasUnfixedLink := true;
+  while wasUnfixedLink do
+  begin
+    f := 0; wasUnfixedLink := false;
+    while f < fFiles.Count do
+    begin
+      fi := TSFSExtFileInfo(fFiles[f]); Inc(f);
+      if (fi = nil) or (fi.fLink = '') then continue;
+      c := 0;
+      while c < fFiles.Count do
+      begin
+        if c <> f then
+        begin
+          // link can't be linked to itself
+          if SFSStrComp(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) = 0 then break;
+        end;
+        Inc(c);
+      end;
+      if c < fFiles.Count then
+      begin
+        if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true
+        else
+        begin
+          TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs;
+          TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize;
+          TSFSExtFileInfo(fFiles[c]).fLink := '';
+        end;
+      end
+      else begin Dec(f); fFiles.Delete(f); end; // invalid link
+    end;
+  end;
+end;
+
+procedure TSFSPlainVolume.WAD2ReadDirectory ();
+var
+  fcnt, dofs: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..16] of Char;
+  f, c: Integer;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 4);
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.Position := dofs;
+  while fcnt <> 0 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    fFileStream.ReadBuffer(f, 4);
+    fFileStream.ReadBuffer(c, 4);
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 16);
+    fi.fName := PChar(@name[0]);
+    Dec(fcnt);
+  end;
+end;
+
+procedure TSFSPlainVolume.ALLReadDirectory ();
+var
+  fcnt: Integer;
+  fi: TSFSFileInfo;
+  sign: packed array [0..3] of Char;
+  nameList: TStringList;
+  propList: TObjectList;
+  name: ShortString;
+  f, c: Integer;
+  prp: TAllegroProperty;
+begin
+  nameList := TStringList.Create(); propList := nil;
+  try
+    propList := TObjectList.Create(true);
+    fFileStream.ReadBuffer(sign[0], 4);
+    if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4);
+    // signature skipped
+    fcnt := ReadMD(fFileStream);
+    while fcnt > 0 do
+    begin
+      // collect properties
+      nameList.Clear(); propList.Clear();
+      repeat
+        fFileStream.ReadBuffer(sign[0], 4);
+        if sign <> 'prop' then break;
+        fFileStream.ReadBuffer(sign[0], 4);
+        f := ReadMD(fFileStream); // size
+        if f < 0 then
+        begin
+         {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
+          WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8));
+         {$ENDIF}
+          raise ESFSError.Create('invalid ALLEGRO file');
+        end;
+        if sign = 'NAME' then
+        begin
+          if f > 255 then c := 255 else c := f;
+          FillChar(name, SizeOf(name), 0);
+          fFileStream.ReadBuffer(name[1], c); name[0] := chr(c);
+          Dec(f, c);
+          c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
+          nameList.Add(name);
+        end
+        else
+        begin
+          prp := TAllegroProperty.Create();
+          Move(sign[0], name[1], 4); name[0] := #4;
+          c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1);
+          prp.name := sign;
+          prp.ofs := fFileStream.Position;
+          prp.size := f;
+          propList.Add(prp);
+        end;
+        fFileStream.Seek(f, soCurrent);
+      until false;
+      if nameList.Count = 0 then nameList.Add('untitled_file');
+
+      Move(sign[0], name[1], 4); name[5] := #0;
+      f := 1; while (f <= 4) and (name[f] <> #0) do Inc(f);
+      while (f > 0) and (name[f] <= ' ') do Dec(f);
+      name[0] := chr(f);
+
+      // read size
+      f := ReadMD(fFileStream);
+      c := ReadMD(fFileStream);
+      if f <> c then
+      begin
+       {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
+        WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8));
+       {$ENDIF}
+        raise ESFSError.Create('invalid ALLEGRO file');
+      end;
+
+      // add files
+      while nameList.Count > 0 do
+      begin
+        fi := TSFSFileInfo.Create(self);
+        fi.fName := nameList[0];
+        fi.fPath := name;
+        fi.fSize := c;
+        fi.fOfs := fFileStream.Position;
+        // add properties
+        for f := 0 to propList.Count-1 do
+        begin
+          prp := TAllegroProperty(propList[f]);
+          fi := TSFSFileInfo.Create(self);
+          fi.fName := prp.name;
+          fi.fPath := name+'.props/'+nameList[0];
+          fi.fSize := prp.size;
+          fi.fOfs := prp.ofs;
+        end;
+        nameList.Delete(0);
+      end;
+      fFileStream.Seek(c, soCurrent);
+      Dec(fcnt);
+    end;
+   {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO}
+    WriteLn(ErrOutput, 'ALLEGRO: ok');
+   {$ENDIF}
+  finally
+    propList.Free();
+    nameList.Free();
+  end;
+end;
+
+procedure TSFSPlainVolume.Dune2ReadDirectory ();
+var
+  ofs: LongWord;
+  fi: TSFSFileInfo;
+  name: string[255];
+  ch: Char;
+begin
+  repeat
+    fFileStream.ReadBuffer(ofs, 4);
+    if ofs = 0 then break;
+    name[0] := #0;
+    fFileStream.ReadBuffer(ch, 1);
+    while ch <> #0 do
+    begin
+      if name[0] <> #255 then
+      begin
+        Inc(name[0]); name[ord(name[0])] := ch;
+      end;
+      fFileStream.ReadBuffer(ch, 1);
+    end;
+    if fFiles.Count > 0 then
+    begin
+      fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
+      fi.fSize := ofs-fi.fOfs;
+    end;
+    fi := TSFSFileInfo.Create(self);
+    fi.fOfs := ofs;
+    fi.fSize := 0;
+    fi.fName := name;
+  until false;
+  if fFiles.Count > 0 then
+  begin
+    fi := TSFSFileInfo(fFiles[fFiles.Count-1]);
+    fi.fSize := fFileStream.Size-fi.fOfs;
+  end;
+end;
+
+procedure TSFSPlainVolume.MAXReadDirectory ();
+var
+  fcnt: LongInt;
+  dofs: LongWord;
+  fi: TSFSFileInfo;
+  name: packed array [0..9] of Char;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.ReadBuffer(fcnt, 4);
+  fFileStream.Position := dofs;
+  while fcnt >= 16 do
+  begin
+    fi := TSFSFileInfo.Create(self);
+    FillChar(name[0], Length(name), 0);
+    fFileStream.ReadBuffer(name[0], 8);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    fi.fName := PChar(@name[0]);
+    Dec(fcnt, 16);
+  end;
+end;
+
+
+procedure TSFSPlainVolume.ReadDirectory ();
+begin
+  case fType of
+    sfspvWAD: WADReadDirectory();
+    sfspvPAK: PAKReadDirectory();
+    sfspvGRP: GRPReadDirectory();
+    sfspvSPE: SPEReadDirectory();
+    sfspvWAD2: WAD2ReadDirectory();
+    sfspvALL: ALLReadDirectory();
+    sfspvDune2: Dune2ReadDirectory();
+    sfspvMAX: MAXReadDirectory();
+    sfspvSIN: SINReadDirectory();
+    else raise ESFSError.Create('invalid plain SFS');
+  end;
+end;
+
+function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
+var
+  fs: TStream;
+  kill: Boolean;
+begin
+  result := nil; fs := nil;
+  if fFiles = nil then exit;
+  if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
+  if not (fFiles[index] is TSFSExtFileInfo) or
+     (Length(TSFSExtFileInfo(fFiles[index]).fVBuf) < 1) then
+  begin
+    kill := false;
+    try
+      try
+        fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
+        kill := true;
+      except
+        fs := fFileStream;
+      end;
+      result := TSFSPartialStream.Create(fs,
+        TSFSFileInfo(fFiles[index]).fOfs,
+        TSFSFileInfo(fFiles[index]).fSize, kill);
+    except
+      if kill then FreeAndNil(fs);
+      result := nil;
+    end;
+  end
+  else
+  begin
+    kill := false;
+    try
+      try
+        fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
+        kill := true;
+      except
+        fs := fFileStream;
+      end;
+      result := TSFSPartialStream.Create(fs,
+        TSFSExtFileInfo(fFiles[index]).fOfs,
+        TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf),
+        kill,
+        @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]),
+        Length(TSFSExtFileInfo(fFiles[index]).fVBuf));
+    except
+      if kill then FreeAndNil(fs);
+      result := nil;
+    end;
+  end;
+end;
+
+
+{ TSFSPlainVolumeFactory }
+function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+begin
+  result :=
+    (SFSStrComp(prefix, 'pak') = 0) or
+    //(SFSStrComp(prefix, 'wad') = 0) or // sorry
+    (SFSStrComp(prefix, 'wad2') = 0) or
+    (SFSStrComp(prefix, 'grp') = 0) or
+    (SFSStrComp(prefix, 'spe') = 0) or
+    (SFSStrComp(prefix, 'spec') = 0) or
+    (SFSStrComp(prefix, 'quake') = 0) or
+    (SFSStrComp(prefix, 'doom') = 0) or
+    (SFSStrComp(prefix, 'duke3d') = 0) or
+    (SFSStrComp(prefix, 'abuse') = 0) or
+    (SFSStrComp(prefix, 'allegro') = 0) or
+    (SFSStrComp(prefix, 'dune2') = 0) or
+    (SFSStrComp(prefix, 'max') = 0) or
+    (SFSStrComp(prefix, 'sin') = 0);
+end;
+
+procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
+begin
+  vol.Free();
+end;
+
+function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
+var
+  vt: TSFSPlainVolumeType;
+begin
+  vt := sfspvNone;
+  if WADCheckMagic(st) then vt := sfspvWAD
+  else if PAKCheckMagic(st) then vt := sfspvPAK
+  else if GRPCheckMagic(st) then vt := sfspvGRP
+  else if SPECheckMagic(st) then vt := sfspvSPE
+  else if WAD2CheckMagic(st) then vt := sfspvWAD2
+  //else if ALLCheckMagic(st) then vt := sfspvALL
+  else if MAXCheckMagic(st) then vt := sfspvMAX
+  else if SINCheckMagic(st) then vt := sfspvSIN;
+  //else if Dune2CheckMagic(st) then vt := sfspvDune2; // this must be the last!
+
+  if vt <> sfspvNone then
+  begin
+    result := TSFSPlainVolume.Create(fileName, st);
+    TSFSPlainVolume(result).fType := vt;
+    try
+      result.DoDirectoryRead();
+    except
+      FreeAndNil(result);
+      raise;
+    end;
+  end
+  else result := nil;
+end;
+
+
+var
+  pakf: TSFSPlainVolumeFactory;
+initialization
+  pakf := TSFSPlainVolumeFactory.Create();
+  SFSRegisterVolumeFactory(pakf);
+finalization
+  SFSUnregisterVolumeFactory(pakf);
+end.

diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
new file mode 100644 (file)
index 0000000..e76aa9a
--- /dev/null
+++ b/src/sfs/sfsZipFS.pas
@@ -0,0 +1,529 @@
+// Streaming R/O Virtual File System v0.2.0
+// Copyright (C) XL A.S. Ketmar.  All rights reserved
+// See the file aplicense.txt for conditions of use.
+//
+// grouping files with packing:
+//   zip, jar: PKZIP-compatible archives (store, deflate)
+//   fout2   : Fallout II .DAT
+//   vtdb    : Asphyre's VTDb
+//   dfwad   : D2D:F wad archives
+//
+{.$DEFINE SFS_DEBUG_ZIPFS}
+{$MODE DELPHI}
+{.$R-}
+unit sfsZipFS;
+
+interface
+
+uses
+  SysUtils, Classes, Contnrs, sfs;
+
+
+
+type
+  TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvF2DAT, sfszvVTDB, sfszvDFWAD);
+
+  TSFSZipVolume = class(TSFSVolume)
+  protected
+    fType: TSFSZipVolumeType;
+
+    procedure ZIPReadDirectory ();
+    procedure F2DATReadDirectory ();
+    procedure VTDBReadDirectory ();
+    procedure DFWADReadDirectory ();
+
+    procedure ReadDirectory (); override;
+    function OpenFileByIndex (const index: Integer): TStream; override;
+  end;
+
+  TSFSZipVolumeFactory = class (TSFSVolumeFactory)
+  public
+    function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override;
+    function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override;
+    procedure Recycle (vol: TSFSVolume); override;
+  end;
+
+
+
+implementation
+
+uses
+  zstream, xstreams;
+
+
+type
+  TZDecompressionStream = TDecompressionStream;
+
+type
+  TSFSZipFileInfo = class (TSFSFileInfo)
+  public
+    fMethod: Byte; // 0: store; 8: deflate; 255: other
+    fPackSz: Int64;
+  end;
+
+  TZLocalFileHeader = packed record
+    version: Byte;
+    hostOS: Byte;
+    flags: Word;
+    method: Word;
+    time: LongWord;
+    crc: LongWord;
+    packSz: LongWord;
+    unpackSz: LongWord;
+    fnameSz: Word;
+    localExtraSz: Word;
+  end;
+
+
+function ZIPCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+begin
+  result := false;
+  st.ReadBuffer(sign[0], 4);
+  st.Seek(-4, soCurrent);
+  if (sign <> 'PK'#3#4) and (sign <> 'PK'#5#6) then exit;
+  result := true;
+end;
+
+function F2DATCheckMagic (st: TStream): Boolean;
+var
+  dsize, fiSz: Integer;
+begin
+  result := false;
+  st.Position := st.Size-8;
+  st.ReadBuffer(dsize, 4); st.ReadBuffer(fiSz, 4);
+  st.Position := 0;
+  if (fiSz <> st.Size) or (dsize < 5+13) or (dsize > fiSz-4) then exit;
+  result := true;
+end;
+
+function VTDBCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..3] of Char;
+  fcnt, dofs: Integer;
+begin
+  result := false;
+  if st.Size < 32 then exit;
+  st.ReadBuffer(sign[0], 4);
+  st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
+  st.Seek(-12, soCurrent);
+  if sign <> 'vtdm' then exit;
+  if (fcnt < 0) or (dofs < 32) or (dofs+fcnt*8 > st.Size) then exit;
+  result := true;
+end;
+
+function DFWADCheckMagic (st: TStream): Boolean;
+var
+  sign: packed array [0..5] of Char;
+  fcnt: Word;
+begin
+  result := false;
+  if st.Size < 10 then exit;
+  st.ReadBuffer(sign[0], 6);
+  st.ReadBuffer(fcnt, 2);
+  st.Seek(-8, soCurrent);
+  //writeln('trying DFWAD... [', sign, ']');
+  if (sign[0] <> 'D') and (sign[1] <> 'F') and (sign[2] <> 'W') and
+     (sign[3] <> 'A') and (sign[4] <> 'D') and (sign[5] <> #$01) then exit;
+  //writeln('DFWAD FOUND, with ', fcnt, ' files');
+  //if (fcnt < 0) then exit;
+  result := true;
+end;
+
+
+{ TSFSZipVolume }
+procedure TSFSZipVolume.ZIPReadDirectory ();
+var
+  fi: TSFSZipFileInfo;
+  name: ShortString;
+  sign, dSign: packed array [0..3] of Char;
+  lhdr: TZLocalFileHeader;
+  ignoreFile, skipped: Boolean;
+  crc, psz, usz: LongWord;
+  buf: packed array of Byte;
+  bufPos, bufUsed: Integer;
+begin
+  SetLength(buf, 0);
+  // read local directory
+  repeat
+    fFileStream.ReadBuffer(sign[0], Length(sign));
+
+    if sign <> 'PK'#3#4 then break;
+
+    ignoreFile := false; skipped := false;
+    fi := TSFSZipFileInfo.Create(self);
+    fi.fPackSz := 0;
+    fi.fMethod := 0;
+
+    fFileStream.ReadBuffer(lhdr, SizeOf(lhdr));
+    if lhdr.fnameSz > 255 then name[0] := #255 else name[0] := chr(lhdr.fnameSz);
+    fFileStream.ReadBuffer(name[1], Length(name));
+    fFileStream.Seek(lhdr.fnameSz-Length(name), soCurrent); // rest of the name (if any)
+    fi.fName := name;
+    fFileStream.Seek(lhdr.localExtraSz, soCurrent);
+
+    if (lhdr.flags and 1) <> 0 then
+    begin
+      // encrypted file: skip it
+      ignoreFile := true;
+    end;
+
+    if (lhdr.method <> 0) and (lhdr.method <> 8) then
+    begin
+      // not stored. not deflated. skip.
+      ignoreFile := true;
+    end;
+
+    fi.fOfs := fFileStream.Position;
+    fi.fSize := lhdr.unpackSz;
+    fi.fPackSz := lhdr.packSz;
+    fi.fMethod := lhdr.method;
+
+    if (lhdr.flags and (1 shl 3)) <> 0 then
+    begin
+      // it has a descriptor. stupid thing at all...
+      {$IFDEF SFS_DEBUG_ZIPFS}
+      WriteLn(ErrOutput, 'descr: $', IntToHex(fFileStream.Position, 8));
+      WriteLn(ErrOutput, 'size: ', lhdr.unpackSz);
+      WriteLn(ErrOutput, 'psize: ', lhdr.packSz);
+      {$ENDIF}
+      skipped := true;
+
+      if lhdr.packSz <> 0 then
+      begin
+        // some kind of idiot already did our work (maybe paritally)
+        // trust him (her? %-)
+        fFileStream.Seek(lhdr.packSz, soCurrent);
+      end;
+
+      // scan for descriptor
+      if Length(buf) = 0 then SetLength(buf, 65536);
+      bufPos := 0; bufUsed := 0;
+      fFileStream.ReadBuffer(dSign[0], 4);
+      repeat
+        if dSign <> 'PK'#7#8 then
+        begin
+          // skip one byte
+          Move(dSign[1], dSign[0], 3);
+          if bufPos >= bufUsed then
+          begin
+            bufPos := 0;
+            // int64!
+            if fFileStream.Size-fFileStream.Position > Length(buf) then
+              bufUsed := Length(buf)
+            else bufUsed := fFileStream.Size-fFileStream.Position;
+            if bufUsed = 0 then raise ESFSError.Create('invalid ZIP file');
+            fFileStream.ReadBuffer(buf[0], bufUsed);
+          end;
+          dSign[3] := chr(buf[bufPos]); Inc(bufPos);
+          Inc(lhdr.packSz);
+          continue;
+        end;
+        // signature found: check if it is a real one
+        // ???: make stronger check (for the correct following signature)?
+        // sign, crc, packsize, unpacksize
+        fFileStream.Seek(-bufUsed+bufPos, soCurrent); bufPos := 0; bufUsed := 0;
+        fFileStream.ReadBuffer(crc, 4); // crc
+        fFileStream.ReadBuffer(psz, 4); // packed size
+        // is size correct?
+        if psz = lhdr.packSz then
+        begin
+          // this is a real description. fuck it off
+          fFileStream.ReadBuffer(usz, 4); // unpacked size
+          break;
+        end;
+        // this is just a sequence of bytes
+        fFileStream.Seek(-8, soCurrent);
+        fFileStream.ReadBuffer(dSign[0], 4);
+        Inc(lhdr.packSz, 4);
+      until false;
+      // store correct values
+      fi.fSize := usz;
+      fi.fPackSz := psz;
+    end;
+
+    // skip packed data
+    if not skipped then fFileStream.Seek(lhdr.packSz, soCurrent);
+    if ignoreFile then fi.Free();
+  until false;
+
+  if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then
+  begin
+    {$IFDEF SFS_DEBUG_ZIPFS}
+    WriteLn(ErrOutput, 'end: $', IntToHex(fFileStream.Position, 8));
+    WriteLn(ErrOutput, 'sign: $', sign[0], sign[1], '#', ord(sign[2]), '#', ord(sign[3]));
+    {$ENDIF}
+    raise ESFSError.Create('invalid .ZIP archive (no central dir)');
+  end;
+end;
+
+procedure TSFSZipVolume.F2DATReadDirectory ();
+var
+  dsize: Integer;
+  fi: TSFSZipFileInfo;
+  name: ShortString;
+  f: Integer;
+  b: Byte;
+begin
+  fFileStream.Position := fFileStream.Size-8;
+  fFileStream.ReadBuffer(dsize, 4);
+  fFileStream.Seek(-dsize, soCurrent); Dec(dsize, 4);
+  while dsize > 0 do
+  begin
+    fi := TSFSZipFileInfo.Create(self);
+    fFileStream.ReadBuffer(f, 4);
+    if (f < 1) or (f > 255) then raise ESFSError.Create('invalid Fallout II .DAT file');
+    Dec(dsize, 4+f+13);
+    if dsize < 0 then raise ESFSError.Create('invalid Fallout II .DAT file');
+    name[0] := chr(f); if f > 0 then fFileStream.ReadBuffer(name[1], f);
+    f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
+    fi.fName := name;
+    fFileStream.ReadBuffer(b, 1); // packed?
+    if b = 0 then fi.fMethod := 0 else fi.fMethod := 255;
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    fFileStream.ReadBuffer(fi.fPackSz, 4);
+    fFileStream.ReadBuffer(fi.fOfs, 4);
+  end;
+end;
+
+procedure TSFSZipVolume.VTDBReadDirectory ();
+// idiotic format
+var
+  fcnt, dofs: Integer;
+  keys: array of record name: string; ofs: Integer; end;
+  fi: TSFSZipFileInfo;
+  f, c: Integer;
+  rtype: Word;
+begin
+  fFileStream.Seek(4, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 4);
+  fFileStream.ReadBuffer(dofs, 4);
+  fFileStream.Seek(dofs, soBeginning);
+
+  // read keys
+  SetLength(keys, fcnt);
+  for f := 0 to fcnt-1 do
+  begin
+    fFileStream.ReadBuffer(c, 4);
+    if (c < 0) or (c > 1023) then raise ESFSError.Create('invalid VTDB file');
+    SetLength(keys[f].name, c);
+    if c > 0 then
+    begin
+      fFileStream.ReadBuffer(keys[f].name[1], c);
+      keys[f].name := SFSReplacePathDelims(keys[f].name, '/');
+      if keys[f].name[1] = '/' then Delete(keys[f].name, 1, 1);
+    end;
+    fFileStream.ReadBuffer(keys[f].ofs, 4);
+  end;
+
+  // read records (record type will be converted to directory name)
+  for f := 0 to fcnt-1 do
+  begin
+    fFileStream.Position := keys[f].ofs;
+    fi := TSFSZipFileInfo.Create(self);
+    fFileStream.ReadBuffer(rtype, 2);
+    fFileStream.ReadBuffer(fi.fSize, 4);
+    fFileStream.ReadBuffer(fi.fPackSz, 4);
+    fi.fOfs := fFileStream.Position+12;
+    fi.fName := keys[f].name;
+    fi.fPath := IntToHex(rtype, 4)+'/';
+    fi.fMethod := 255;
+  end;
+end;
+
+procedure TSFSZipVolume.DFWADReadDirectory ();
+// idiotic format
+var
+  fcnt: Word;
+  fi: TSFSZipFileInfo;
+  f, c, fofs, fpksize: Integer;
+  curpath, fname: string;
+  name: packed array [0..15] of Char;
+begin
+  curpath := '';
+  fFileStream.Seek(6, soCurrent); // skip signature
+  fFileStream.ReadBuffer(fcnt, 2);
+  if fcnt = 0 then exit;
+  // read files
+  for f := 0 to fcnt-1 do
+  begin
+    fFileStream.ReadBuffer(name[0], 16);
+    fFileStream.ReadBuffer(fofs, 4);
+    fFileStream.ReadBuffer(fpksize, 4);
+    c := 0;
+    fname := '';
+    while (c < 16) and (name[c] <> #0) do
+    begin
+      if name[c] = '\' then name[c] := '/'
+      else if name[c] = '/' then name[c] := '_';
+      fname := fname+name[c];
+      Inc(c);
+    end;
+    // new directory?
+    if (fofs = 0) and (fpksize = 0) then
+    begin
+      if length(fname) <> 0 then fname := fname+'/';
+      curpath := fname;
+      continue;
+    end;
+    if length(fname) = 0 then continue; // just in case
+    //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize);
+    // create file record
+    fi := TSFSZipFileInfo.Create(self);
+    fi.fOfs := fofs;
+    fi.fSize := -1;
+    fi.fPackSz := fpksize;
+    fi.fName := fname;
+    fi.fPath := curpath;
+    fi.fMethod := 255;
+  end;
+end;
+
+procedure TSFSZipVolume.ReadDirectory ();
+begin
+  case fType of
+    sfszvZIP: ZIPReadDirectory();
+    sfszvF2DAT: F2DATReadDirectory();
+    sfszvVTDB: VTDBReadDirectory();
+    sfszvDFWAD: DFWADReadDirectory();
+    else raise ESFSError.Create('invalid zipped SFS');
+  end;
+end;
+
+function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream;
+var
+  zs: TZDecompressionStream;
+  fs: TStream;
+  gs: TSFSGuardStream;
+  kill: Boolean;
+  buf: packed array [0..1023] of Char;
+  rd: LongInt;
+begin
+  result := nil;
+  zs := nil;
+  fs := nil;
+  gs := nil;
+  if fFiles = nil then exit;
+  if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
+  kill := false;
+  try
+    try
+      fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
+      kill := true;
+    except
+      fs := fFileStream;
+    end;
+    if TSFSZipFileInfo(fFiles[index]).fMethod = 0 then
+    begin
+      result := TSFSPartialStream.Create(fs,
+        TSFSZipFileInfo(fFiles[index]).fOfs,
+        TSFSZipFileInfo(fFiles[index]).fSize, kill);
+    end
+    else
+    begin
+      fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
+      if TSFSZipFileInfo(fFiles[index]).fMethod = 255 then
+      begin
+        zs := TZDecompressionStream.Create(fs)
+      end
+      else
+      begin
+        zs := TZDecompressionStream.Create(fs, true {-15}{MAX_WBITS});
+      end;
+      // sorry, pals, DFWAD is completely broken, so users of it should SUFFER
+      if TSFSZipFileInfo(fFiles[index]).fSize = -1 then
+      begin
+        TSFSZipFileInfo(fFiles[index]).fSize := 0;
+        //writeln('trying to determine file size...');
+        try
+          while true do
+          begin
+            rd := zs.read(buf, 1024);
+            //writeln('  got ', rd, ' bytes');
+            if rd > 0 then Inc(TSFSZipFileInfo(fFiles[index]).fSize, rd);
+            if rd < 1024 then break;
+          end;
+          //writeln('  resulting size: ', TSFSZipFileInfo(fFiles[index]).fSize, ' bytes');
+          // recreate stream
+          FreeAndNil(zs);
+          fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
+          zs := TZDecompressionStream.Create(fs)
+        except
+          FreeAndNil(zs);
+          if kill then FreeAndNil(fs);
+          result := nil;
+          exit;
+        end;
+      end;
+      gs := TSFSGuardStream.Create(zs, fs, true, kill, false);
+      zs := nil;
+      fs := nil;
+      result := TSFSPartialStream.Create(gs, 0, TSFSZipFileInfo(fFiles[index]).fSize, true);
+    end;
+  except
+    FreeAndNil(gs);
+    FreeAndNil(zs);
+    if kill then FreeAndNil(fs);
+    result := nil;
+    exit;
+  end;
+end;
+
+
+{ TSFSZipVolumeFactory }
+function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+begin
+  result :=
+    (SFSStrComp(prefix, 'zip') = 0) or
+    (SFSStrComp(prefix, 'jar') = 0) or
+    (SFSStrComp(prefix, 'fout2') = 0) or
+    (SFSStrComp(prefix, 'vtdb') = 0) or
+    (SFSStrComp(prefix, 'wad') = 0) or
+    (SFSStrComp(prefix, 'dfwad') = 0);
+end;
+
+procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
+begin
+  vol.Free();
+end;
+
+function TSFSZipVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume;
+var
+  vt: TSFSZipVolumeType;
+begin
+  vt := sfszvNone;
+  if ZIPCheckMagic(st) then vt := sfszvZIP
+  else if DFWADCheckMagic(st) then vt := sfszvDFWAD
+  else if F2DATCheckMagic(st) then vt := sfszvF2DAT
+  else if VTDBCheckMagic(st) then vt := sfszvVTDB;
+
+  if vt <> sfszvNone then
+  begin
+    result := TSFSZipVolume.Create(fileName, st);
+    TSFSZipVolume(result).fType := vt;
+    try
+      result.DoDirectoryRead();
+    except {$IFDEF SFS_DEBUG_ZIPFS} on e: Exception do begin
+      WriteLn(errOutput, 'ZIP ERROR: [', e.ClassName, ']: ', e.Message);
+      {$ENDIF}
+      FreeAndNil(result);
+      raise;
+      {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF}
+    end;
+  end
+  else
+  begin
+    result := nil;
+  end;
+end;
+
+
+var
+  zipf: TSFSZipVolumeFactory;
+initialization
+  zipf := TSFSZipVolumeFactory.Create();
+  SFSRegisterVolumeFactory(zipf);
+finalization
+  SFSUnregisterVolumeFactory(zipf);
+end.

diff --git a/src/sfs/xstreams.pas b/src/sfs/xstreams.pas
new file mode 100644 (file)
index 0000000..a9026cf
--- /dev/null
+++ b/src/sfs/xstreams.pas
@@ -0,0 +1,297 @@
+// special stream classes
+{$MODE DELPHI}
+{.$R-}
+unit xstreams;
+
+interface
+
+uses
+  SysUtils, Classes, SDL2;
+
+
+type
+  // ïîòîê-îá¸ðòêà äëÿ SDL_RWops
+  TSFSSDLStream = class(TStream)
+  protected
+    fRW: PSDL_RWops;      // SDL-íàÿ ïðîêëàäêà
+    fFreeSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
+
+  public
+    constructor Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
+    destructor Destroy (); override;
+
+    function Read (var buffer; count: LongInt): LongInt; override;
+    function Write (const buffer; count: LongInt): LongInt; override;
+    function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+  end;
+
+  // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
+  TSFSPartialStream = class(TStream)
+  protected
+    fSource: TStream;     // èñõîäíûé ïîòîê
+    fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
+    fLastReadPos: Int64;  // ïîñëåäíèé Read() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
+    fCurrentPos: Int64;   // ïîñëåäíèé Seek() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
+    fStartPos: Int64;     // íà÷àëî êóñî÷êà
+    fSize: Int64;         // äëèíà êóñî÷êà
+    fPreBuf: packed array of Byte; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì
+
+    procedure CheckPos ();
+
+  public
+    // aSrc: ïîòîê-èñõîäíèê.
+    // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé.
+    //       åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí
+    //       íîðìàëüíî ïîääåðæèâàòü Seek()!
+    // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà.
+    //        åñëè ìåíüøå íóëÿ -- òî äî êîíöà.
+    // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
+    // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê
+    // äëèíå ôàéëà.
+    constructor Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
+    destructor Destroy (); override;
+
+    // íîðìàëèçóåò count è ÷èòàåò.
+    function Read (var buffer; count: LongInt): LongInt; override;
+    // Write() ïðîñòî ãðîìêî ïàäàåò.
+    function Write (const buffer; count: LongInt): LongInt; override;
+    // Seek() ðåàëèçîâàíî, ÷òîáû ìîãëà ðàáîòàòü ïðîïåðòÿ Size.
+    // âîîáùå-òî ìîæíî ïåðåêðûòü ìåòîä GetSize(), íî âäðóã êàêîé
+    // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè
+    // Seek()'à?
+    function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+  end;
+
+  TSFSGuardStream = class(TStream)
+  protected
+    fSource: TStream;        // èñõîäíûé ïîòîê
+    fGuardedStream: TStream; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè
+    fKillSource: Boolean;    // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
+    fKillGuarded: Boolean;   // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè?
+    fGuardedFirst: Boolean;  // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî?
+
+  public
+    // aSrc: ïîòîê-èñõîäíèê (íà êîòîðûé çàìàïåíû îïåðàöèè ÷òåíèÿ/çàïèñè).
+    // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
+    // aKillGuarded: óáèâàòü ëè îõðàíÿåìûé ïîòîê, êîãäà ñàìè óìèðàåì?
+    // aGuardedFirst: true: ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî.
+    constructor Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
+    destructor Destroy (); override;
+
+    // íèæåñëåäóþùåå çàìàïëåíî íà fSource
+    function Read (var buffer; count: LongInt): LongInt; override;
+    function Write (const buffer; count: LongInt): LongInt; override;
+    function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+  end;
+
+  TSFSMemoryStreamRO = class(TCustomMemoryStream)
+  public
+    constructor Create (pMem: Pointer; pSize: Integer);
+
+    function Write (const buffer; count: LongInt): LongInt; override;
+  end;
+
+
+implementation
+
+uses
+  sfs; // for ESFSError
+
+{ TSFSSDLStream }
+constructor TSFSSDLStream.Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true);
+begin
+  inherited Create();
+  //ASSERT(aSrc <> nil);
+  fRW := aSrc;
+  fFreeSource := aFreeSource;
+end;
+
+destructor TSFSSDLStream.Destroy ();
+begin
+  if fFreeSource and (fRW <> nil) then SDL_FreeRW(fRW);
+  inherited Destroy();
+end;
+
+function TSFSSDLStream.Read (var buffer; count: LongInt): LongInt;
+begin
+  if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
+  result := SDL_RWread(fRW, @buffer, 1, count);
+end;
+
+function TSFSSDLStream.Write (const buffer; count: LongInt): LongInt;
+begin
+  if (fRW = nil) or (count <= 0) then begin result := 0; exit; end;
+  result := SDL_RWwrite(fRW, @buffer, 1, count);
+end;
+
+function TSFSSDLStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+var
+  ss: Integer;
+begin
+  if fRW = nil then begin result := 0; exit; end;
+  case origin of
+    soBeginning: ss := RW_SEEK_SET;
+    soCurrent: ss := RW_SEEK_CUR;
+    soEnd: ss := RW_SEEK_END;
+    else raise ESFSError.Create('invalid Seek() call');
+    // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
+  end;
+  result := SDL_RWseek(fRW, offset, ss);
+  if result = -1 then raise ESFSError.Create('Seek() error');
+end;
+
+
+{ TSFSPartialStream }
+constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
+begin
+  inherited Create();
+  ASSERT(aSrc <> nil);
+  if aPos < 0 then aPos := aSrc.Position;
+  if aSize < 0 then aSize := 0;
+  fSource := aSrc;
+  fKillSource := aKillSrc;
+  fLastReadPos := 0;
+  fCurrentPos := 0;
+  fStartPos := aPos;
+  fSize := aSize;
+  if bufSz > 0 then
+  begin
+    SetLength(fPreBuf, bufSz);
+    Move(preBuf^, fPreBuf[0], bufSz);
+    Inc(fSize, bufSz);
+  end
+  else
+  begin
+    fPreBuf := nil;
+  end;
+end;
+
+destructor TSFSPartialStream.Destroy ();
+begin
+  if fKillSource then FreeAndNil(fSource);
+  inherited Destroy();
+end;
+
+procedure TSFSPartialStream.CheckPos ();
+begin
+  if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
+  begin
+    fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
+  end;
+  fLastReadPos := fCurrentPos;
+end;
+
+function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
+begin
+  result := 0;
+  raise ESFSError.Create('can''t write to read-only stream');
+  // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
+end;
+
+function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt;
+var
+  left: Int64;
+  pc: Pointer;
+  rd: LongInt;
+begin
+  if count < 0 then raise ESFSError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
+  if count = 0 then begin result := 0; exit; end;
+  pc := @buffer;
+  result := 0;
+  if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then
+  begin
+    fLastReadPos := fCurrentPos;
+    left := Length(fPreBuf)-fCurrentPos;
+    if left > count then left := count;
+    if left > 0 then
+    begin
+      Move(fPreBuf[fCurrentPos], pc^, left);
+      Inc(PChar(pc), left);
+      Inc(fCurrentPos, left);
+      fLastReadPos := fCurrentPos;
+      Dec(count, left);
+      result := left;
+      if count = 0 then exit;
+    end;
+  end;
+  CheckPos();
+  left := fSize-fCurrentPos;
+  if left < count then count := left; // è òàê ñëó÷àåòñÿ...
+  if count > 0 then
+  begin
+    rd := fSource.Read(pc^, count);
+    Inc(result, rd);
+    Inc(fCurrentPos, rd);
+    fLastReadPos := fCurrentPos;
+  end
+  else
+  begin
+    result := 0;
+  end;
+end;
+
+function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+begin
+  case origin of
+    soBeginning: result := offset;
+    soCurrent: result := offset+fCurrentPos;
+    soEnd: result := fSize+offset;
+    else raise ESFSError.Create('invalid Seek() call');
+    // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
+  end;
+  if result < 0 then result := 0
+  else if result > fSize then result := fSize;
+  fCurrentPos := result;
+end;
+
+
+{ TSFSGuardStream }
+constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
+begin
+  inherited Create();
+  fSource := aSrc; fGuardedStream := aGuarded;
+  fKillSource := aKillSrc; fKillGuarded := aKillGuarded;
+  fGuardedFirst := aGuardedFirst;
+end;
+
+destructor TSFSGuardStream.Destroy ();
+begin
+  if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream);
+  if fKillSource then FreeAndNil(fSource);
+  if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream);
+  inherited Destroy();
+end;
+
+function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt;
+begin
+  result := fSource.Read(buffer, count);
+end;
+
+function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt;
+begin
+  result := fSource.Write(buffer, count);
+end;
+
+function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+begin
+  result := fSource.Seek(offset, origin);
+end;
+
+
+{ TSFSMemoryStreamRO }
+constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer);
+begin
+  inherited Create();
+  SetPointer(pMem, pSize);
+  Position := 0;
+end;
+
+function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
+begin
+  result := 0;
+  raise ESFSError.Create('can''t write to read-only stream');
+  // ñîâñåì ñáðåíäèë...
+end;
+
+
+end.