network: it should find correct files on POSIX now (and substitute extensions too)

[d2df-sdl.git] / src / sfs / sfs.pas

// streaming file system (virtual)
{$MODE DELPHI}
{.$R-}
{.$DEFINE SFS_VOLDEBUG}
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
    fRC: Integer; // refcounter for other objects
    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;

    // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles
    function GetFileCount (): Integer; virtual;

    // âîçâðàùàåò ôàéë ñ èíäåêñîì index.
    // ìîæåò âîçâðàùàòü NIL.
    // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
    function GetFiles (index: Integer): TSFSFileInfo; virtual;

    procedure removeCommonPath (); virtual;

  public
    // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
    constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
    // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
    destructor Destroy (); override;

    // âûçûâàåò ReadDirectory().
    // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â
    // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð.
    // òàêæå îíà íîðìàëèçóåò âèä èì¸í.
    procedure DoDirectoryRead ();

    // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè.
    function OpenFileByIndex (const index: Integer): TStream; virtual; abstract;

    // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
    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 Volume: TSFSVolume read fVolume;
    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;

// äîáàâèòü ñáîðíèê âðåìåííî
function SFSAddDataFileTemp (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;

// çàïðåòèòü îñâîáîæäåíèå âðåìåííûõ òîìîâ (ìîæíî âûçûâàòü ðåêóðñèâíî)
procedure sfsGCDisable ();

// ðàçðåøèòü îñâîáîæäåíèå âðåìåííûõ òîìîâ (ìîæíî âûçûâàòü ðåêóðñèâíî)
procedure sfsGCEnable ();

// for completeness sake
procedure sfsGCCollect ();


function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
// èãíîðèðóåò ðåãèñòð ñèìâîëîâ
function SFSStrEqu (const s0, s1: TSFSString): Boolean;

// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
function SFSGetLastVirtualName (const fn: TSFSString): string;

// ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè
function Int64ToStrComma (i: Int64): string;

// `name` will be modified
// return `true` if file was found
function sfsFindFileCI (path: string; var name: string): Boolean;

// 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;

function SFSUpCase (ch: Char): Char;

function utf8to1251 (s: TSFSString): TSFSString;


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;


// `name` will be modified
function sfsFindFileCI (path: string; var name: string): Boolean;
var
  sr: TSearchRec;
  bestname: string = '';
begin
  if length(path) = 0 then path := '.';
  while (length(path) > 0) and (path[length(path)] = '/') do Delete(path, length(path), 1);
  if (length(path) = 0) or (path[length(path)] <> '/') then path := path+'/';
  if FileExists(path+name) then begin result := true; exit; end;
  if FindFirst(path+'*', faAnyFile, sr) = 0 then
  repeat
    if (sr.name = '.') or (sr.name = '..') then continue;
    if (sr.attr and faDirectory) <> 0 then continue;
    if sr.name = name then
    begin
      FindClose(sr);
      result := true;
      exit;
    end;
    if (length(bestname) = 0) and SFSStrEqu(sr.name, name) then bestname := sr.name;
  until FindNext(sr) <> 0;
  FindClose(sr);
  if length(bestname) > 0 then begin result := true; name := bestname; end else result := false;
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
  gcdisabled: Integer = 0; // >0: disabled


procedure sfsGCCollect ();
var
  f, c: Integer;
  vi: TVolumeInfo;
  used: Boolean;
begin
  // collect garbage
  f := 0;
  while f < volumes.Count do
  begin
    vi := TVolumeInfo(volumes[f]);
    if vi = nil then continue;
    if (not vi.fPermanent) and (vi.fVolume.fRC = 0) and (vi.fOpenedFilesCount = 0) then
    begin
      // this volume probably can be removed
      used := false;
      c := volumes.Count-1;
      while not used and (c >= 0) do
      begin
        if (c <> f) and (volumes[c] <> nil) then
        begin
          used := (TVolumeInfo(volumes[c]).fStream = vi.fStream);
          if not used then used := (TVolumeInfo(volumes[c]).fVolume.fFileStream = vi.fStream);
          if used then break;
        end;
        Dec(c);
      end;
      if not used then
      begin
        {$IFDEF SFS_VOLDEBUG}writeln('000: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF}
        volumes.extract(vi); // remove from list
        vi.Free; // and kill
        f := 0;
        continue;
      end;
    end;
    Inc(f); // next volume
  end;
end;

procedure sfsGCDisable ();
begin
  Inc(gcdisabled);
end;

procedure sfsGCEnable ();
begin
  Dec(gcdisabled);
  if gcdisabled <= 0 then
  begin
    gcdisabled := 0;
    sfsGCCollect();
  end;
end;


// ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
// ñîáñòâåííî èìÿ ôàéëà
// èìÿ âûãëÿäèò êàê:
// (("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 SFSStrEqu(vi.fPackName, dataFileName) 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;

function SFSUpCase (ch: Char): Char;
begin
  if ch < #128 then
  begin
    if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32);
  end
  else
  begin
    if (ch >= #224) and (ch <= #255) then
    begin
      Dec(ch, 32);
    end
    else
    begin
      case ch of
        #184, #186, #191: Dec(ch, 16);
        #162, #179: Dec(ch);
      end;
    end;
  end;
  result := ch;
end;

function SFSStrEqu (const s0, s1: TSFSString): Boolean;
var
  i: Integer;
begin
  //result := (AnsiCompareText(s0, s1) == 0);
  result := false;
  if length(s0) <> length(s1) then exit;
  for i := 1 to length(s0) do
  begin
    if SFSUpCase(s0[i]) <> SFSUpCase(s1[i]) then exit;
  end;
  result := true;
end;

// adds '/' too
function normalizePath (fn: string): string;
var
  i: Integer;
begin
  result := '';
  i := 1;
  while i <= length(fn) do
  begin
    if (fn[i] = '.') and ((length(fn)-i = 0) or (fn[i+1] = '/') or (fn[i+1] = '\')) then
    begin
      i := i+2;
      continue;
    end;
    if (fn[i] = '/') or (fn[i] = '\') then
    begin
      if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
    end
    else
    begin
      result := result+fn[i];
    end;
    Inc(i);
  end;
  if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
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);
  if fVolume <> nil then used := (fVolume.fRC <> 0) else used := false;
  fVolume := nil;
  fFactory := nil;
  fPackName := '';

  // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ, òî óãðîáèòü åãî íàôèã
  if not used then
  begin
    me := volumes.IndexOf(self);
    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
        begin
          used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream);
        end;
        if used then break;
      end;
      Dec(f);
    end;
  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 (gcdisabled = 0) and not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then
    begin
      f := volumes.IndexOf(fOwner);
      if f <> -1 then
      begin
        {$IFDEF SFS_VOLDEBUG}writeln('001: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF}
        volumes[f] := nil; // this will destroy the volume
      end;
    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();
  fRC := 0;
  fFileStream := pSt;
  fFileName := pFileName;
  fFiles := TObjectList.Create(true);
end;

procedure TSFSVolume.removeCommonPath ();
begin
end;

procedure TSFSVolume.DoDirectoryRead ();
var
  f, c: Integer;
  sfi: TSFSFileInfo;
  tmp: TSFSString;
begin
  fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
  ReadDirectory();
  fFiles.Pack();

  f := 0;
  while f < fFiles.Count 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;
    sfi.fPath := normalizePath(sfi.fPath);
    if (length(sfi.fPath) = 0) and (length(sfi.fName) = 0) then sfi.Free else Inc(f);
  end;
  removeCommonPath();
end;

destructor TSFSVolume.Destroy ();
begin
  Clear();
  FreeAndNil(fFiles);
  inherited Destroy();
end;

procedure TSFSVolume.Clear ();
begin
  fRC := 0; //FIXME
  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 SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and
           SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) 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);
  if fVolume <> nil then Dec(fVolume.fRC);
  Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
  // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
  if (gcdisabled = 0) and not TVolumeInfo(volumes[f]).fPermanent and (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then
  begin
    {$IFDEF SFS_VOLDEBUG}writeln('002: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF}
    volumes[f] := nil;
  end;
  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 (gcdisabled = 0) and 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}fmShareDenyNone);
  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 SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false): Boolean;
var
  tv: Integer;
begin
  try
    if top then tv := -1 else tv := 1;
    SFSAddDataFileEx(dataFileName, nil, tv, 0);
    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}fmShareDenyNone);
        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 (gcdisabled = 0) and 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);
    Inc(vi.fVolume.fRC);
  except
    if (gcdisabled = 0) and not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
  end;
end;


// ////////////////////////////////////////////////////////////////////////// //
// utils
// `ch`: utf8 start
// -1: invalid utf8
function utf8CodeLen (ch: Word): Integer;
begin
  if ch < $80 then begin result := 1; exit; end;
  if (ch and $FE) = $FC then begin result := 6; exit; end;
  if (ch and $FC) = $F8 then begin result := 5; exit; end;
  if (ch and $F8) = $F0 then begin result := 4; exit; end;
  if (ch and $F0) = $E0 then begin result := 3; exit; end;
  if (ch and $E0) = $C0 then begin result := 2; exit; end;
  result := -1; // invalid
end;


function utf8Valid (s: string): Boolean;
var
  pos, len: Integer;
begin
  result := false;
  pos := 1;
  while pos <= length(s) do
  begin
    len := utf8CodeLen(Byte(s[pos]));
    if len < 1 then exit; // invalid sequence start
    if pos+len-1 > length(s) then exit; // out of chars in string
    Dec(len);
    Inc(pos);
    // check other sequence bytes
    while len > 0 do
    begin
      if (Byte(s[pos]) and $C0) <> $80 then exit;
      Dec(len);
      Inc(pos);
    end;
  end;
  result := true;
end;


// ////////////////////////////////////////////////////////////////////////// //
const
  // TODO: move this to a separate file
  uni2wint: array [128..255] of Word = (
    $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
    $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
    $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
    $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
    $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
    $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
    $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
    $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
  );


function decodeUtf8Char (s: TSFSString; var pos: Integer): char;
var
  b, c: Integer;
begin
  (* The following encodings are valid, except for the 5 and 6 byte
   * combinations:
   *  0xxxxxxx
   *  110xxxxx 10xxxxxx
   *  1110xxxx 10xxxxxx 10xxxxxx
   *  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
   *  111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
   *  1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
   *)
  result := '?';
  if pos > length(s) then exit;

  b := Byte(s[pos]);
  Inc(pos);
  if b < $80 then begin result := char(b); exit; end;

  // mask out unused bits
       if (b and $FE) = $FC then b := b and $01
  else if (b and $FC) = $F8 then b := b and $03
  else if (b and $F8) = $F0 then b := b and $07
  else if (b and $F0) = $E0 then b := b and $0F
  else if (b and $E0) = $C0 then b := b and $1F
  else exit; // invalid utf8

  // now continue
  while pos <= length(s) do
  begin
    c := Byte(s[pos]);
    if (c and $C0) <> $80 then break; // no more
    b := b shl 6;
    b := b or (c and $3F);
    Inc(pos);
  end;

  // done, try 1251
  for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end;
  // alas
end;


function utf8to1251 (s: TSFSString): TSFSString;
var
  pos: Integer;
begin
  if not utf8Valid(s) then begin result := s; exit; end;
  pos := 1;
  while pos <= length(s) do
  begin
    if Byte(s[pos]) >= $80 then break;
    Inc(pos);
  end;
  if pos > length(s) then begin result := s; exit; end; // nothing to do here
  result := '';
  pos := 1;
  while pos <= length(s) do result := result+decodeUtf8Char(s, pos);
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.