src/sfs/sfs.pas

   1 // streaming file system (virtual)
   2 {$MODE DELPHI}
   3 {.$R-}
   4 unit sfs;
   5
   6 interface
   7
   8 uses
   9   SysUtils, Classes, Contnrs;
  10
  11
  12 type
  13   ESFSError = class(Exception);
  14
  15   TSFSChar = AnsiChar;
  16   TSFSString = AnsiString;
  17
  18   TSFSVolume = class;
  19
  20   TSFSFileInfo = class
  21   public
  22     fOwner: TSFSVolume; // òàê, íà âñÿêèé ñëó÷àé
  23     fPath: TSFSString;  // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/"
  24     fName: TSFSString;  // òîëüêî èìÿ
  25     fSize: Int64;       // unpacked
  26     fOfs: Int64;        // in VFS (many of 'em need this %-)
  27
  28     constructor Create (pOwner: TSFSVolume);
  29     destructor Destroy (); override;
  30
  31     property path: TSFSString read fPath;
  32     property name: TSFSString read fName;
  33     property size: Int64 read fSize;
  34   end;
  35
  36   // âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß!
  37   // òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè!
  38   TSFSVolume = class
  39   protected
  40     fFileName: TSFSString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà
  41     fFileStream: TStream; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà
  42     fFiles: TObjectList;  // TSFSFileInfo èëè íàñëåäíèêè
  43
  44     // ïðèøèáèòü âñå ñòðóêòóðû.
  45     // íå äîëæíà ïàäàòü, åñëè å¸ âûçûâàþò íåñêîëüêî ðàç.
  46     procedure Clear (); virtual;
  47
  48     // âûçûâàåòñÿ èç DoDirectoryRead() äëÿ çàïîëíåíèÿ ñïèñêà ôàéëîâ.
  49     // ñ÷èòàåòñÿ, ÷òî âñå ìàãèêè óæå ïðîâåðåíû è ôàéë òî÷íî íàø.
  50     // fFileName, fFileStream óæå óñòàíîâëåíû, fFiles ñîçäàí,
  51     // â í¸ì, ñêîðåå âñåãî, íèêîãî íåò.
  52     // ïîçèöèÿ ïîòîêà -- òà, ÷òî îñòàâèëà ôàáðèêà.
  53     // ïðè îøèáêàõ êèäàòü èñêëþ÷åíèå, òîãäà òîì áóäåò ïðèáèò ôàáðèêîé.
  54     // ðàçäåëèòåëè ïóòåé äîëæíû áûòü òîëüêî "/", êîðíåâîé "/" äîëæåí
  55     // áûòü îïóùåí, ïóòè (åñëè íå ïóñòûå) äîëæíû çàâåðøàòüñÿ "/"!
  56     // fName äîëæíî ñîäåðæàòü òîëüêî èìÿ, fPath -- òîëüêî ïóòü.
  57     // â ïðèíöèïå, îá ýòîì ïîçàáîòèòñÿ DoDirectoryRead(), íî çà÷åì
  58     // äàâàòü åìó ëèøíþþ ðàáîòó?
  59     procedure ReadDirectory (); virtual; abstract;
  60
  61     // íàéòè ôàéë, âåðíóòü åãî èíäåêñ â fFiles.
  62     // ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles!
  63     // fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí.
  64     // åñëè ôàéë íå íàéäåí, âåðíóòü -1.
  65     function FindFile (const fPath, fName: TSFSString): Integer; virtual;
  66
  67     // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè.
  68     function OpenFileByIndex (const index: Integer): TStream; virtual; abstract;
  69
  70     // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles
  71     function GetFileCount (): Integer; virtual;
  72
  73     // âîçâðàùàåò ôàéë ñ èíäåêñîì index.
  74     // ìîæåò âîçâðàùàòü NIL.
  75     // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
  76     function GetFiles (index: Integer): TSFSFileInfo; virtual;
  77
  78   public
  79     // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
  80     constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
  81     // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
  82     destructor Destroy (); override;
  83
  84     // âûçûâàåò ReadDirectory().
  85     // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â
  86     // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð.
  87     // òàêæå îíà íîðìàëèçóåò âèä èì¸í.
  88     procedure DoDirectoryRead ();
  89
  90     // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
  91     function OpenFileEx (const fName: TSFSString): TStream; virtual;
  92
  93     property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü
  94     // ìîæåò âîçâðàùàòü NIL.
  95     // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
  96     property Files [index: Integer]: TSFSFileInfo read GetFiles;
  97   end;
  98
  99   // ôàáðèêà òîìîâ. âñå SFS ïðè ñòàðòå äîáàâëÿþò ñâîè ôàáðèêè.
 100   // áëàãîäàðÿ ýòîìó ìîæíî ñîçäàâàòü ðàçíûå âñÿêèå SFS ñòàíäàðòíûì
 101   // âûçîâîì ñòàíäàðòíîé ïðîöåäóðû.
 102   // ôàáðèêà ÍÅ ÄÎËÆÍÀ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè âûçîâà
 103   // SFSUnregisterVolumeFactory()! ýòî ãàðàíòèðóåò, ÷òî äâèæîê
 104   // ïåðåä ðàññòðåëîì îòäàñò åé âñå å¸ òîìà.
 105   TSFSVolumeFactory = class
 106   public
 107     // åñëè äîáàâëÿåì ôàéë äàííûõ ôàéë ñ èìåíåì òèïà "zip:....", òî
 108     // SFS èçâëå÷¸ò ýòî "zip" è ïåðåäàñò â ñèþ ôóíêöèþ.
 109     // åæåëè ôóíêöèÿ âåðí¸ò ïðàâäó, òî SFS âûçîâåò Produce äëÿ äàííîãî
 110     // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò.
 111     // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà.
 112     // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ!
 113     function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract;
 114     // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà.
 115     // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå.
 116     // ýòîò ïîòîê íåëüçÿ çàêðûâàòü!
 117     // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''.
 118     // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé.
 119     function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract;
 120     // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó.
 121     // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì.
 122     procedure Recycle (vol: TSFSVolume); virtual; abstract;
 123   end;
 124
 125   // "èòåðàòîð", âîçâðàùàåìûé SFSFileList()
 126   TSFSFileList = class
 127   protected
 128     fVolume: TSFSVolume;
 129
 130     function GetCount (): Integer;
 131     function GetFiles (index: Integer): TSFSFileInfo;
 132
 133   public
 134     constructor Create (const pVolume: TSFSVolume);
 135     destructor Destroy (); override;
 136
 137     property Count: Integer read GetCount;
 138     // ïðè íåïðàâèëüíîì èíäåêñå ìîë÷à âåðí¸ò NIL.
 139     // ïðè ïðàâèëüíîì òîæå ìîæåò âåðíóòü NIL!
 140     // î÷åíü íå ñîâåòóþ ìåíÿòü ñîäåðæèìîå ïîëó÷åííîãî êëàññà.
 141     // êîíå÷íî, ÿ ìîã áû âîçâðàùàòü íîâóþ ñòðóêòóðó èëè íå÷òî ïîõîæåå,
 142     // íî áëèí, åñëè òû èäèîò è íå óìååøü äàæå êîììåíòû ÷èòàòü, òî
 143     // êàêîãî òû âîîáùå â ïðîãðàììèíã ïîëåç?
 144     property Files [index: Integer]: TSFSFileInfo read GetFiles; default;
 145   end;
 146
 147
 148 procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
 149 // ýòà ôóíêöèÿ àâòîìàòè÷åñêè ïðèáü¸ò factory.
 150 procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
 151
 152 // äîáàâèòü ñáîðíèê â ïîñòîÿííûé ñïèñîê.
 153 // åñëè ñáîðíèê ñ òàêèì èìåíåì óæå îòêðûò, òî íå îòêðûâàåò åãî ïîâòîðíî.
 154 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
 155 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
 156 // âåðí¸ò ëîæü ïðè îøèáêå.
 157 // ñïîñîáíî îòêðûâàòü ñáîðíèêè â ñáîðíèêàõ ïðè ïîìîùè êðóòûõ èì¸í a-la:
 158 // "zip:pack0::pack:pack1::wad2:pack2".
 159 // â äàëüíåéøåì ñëåäóåò îáðàùàòüñÿ ê ñáîðíèêó êàê "pack2::xxx".
 160 // èëè ìîæíî íàïèñàòü:
 161 // "zip:pack0::pack:pack1::wad2:pack2|datafile".
 162 // è îáðàùàòüñÿ êàê "datafile::xxx".
 163 // "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ.
 164 // ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà.
 165 function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean;
 166
 167 // äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds.
 168 // åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà
 169 // óãðîáèò ñåé ïîòîê ïî íåîáõîäèìîñòè.
 170 // virtualName ñòàíîâèòñÿ èìåíåì ñáîðíèêà äëÿ îïåðàöèè îòêðûòèÿ ôàéëà òèïà
 171 // "packfile:file.ext".
 172 // åñëè êàêîé-íèáóäü ñáîðíèê ñ èìåíåì virtualName óæå îòêðûò, âåðí¸ò false.
 173 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
 174 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
 175 // âåðí¸ò ëîæü ïðè îøèáêå.
 176 // îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ.
 177 // ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå.
 178 function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean;
 179
 180 // øâûðÿåòñÿ èñêëþ÷åíèÿìè.
 181 // åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò
 182 // îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì
 183 // ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè.
 184 // åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå.
 185 function SFSFileOpenEx (const fName: TSFSString): TStream;
 186
 187 // ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé.
 188 function SFSFileOpen (const fName: TSFSString): TStream;
 189
 190 // âîçâðàùàåò NIL ïðè îøèáêå.
 191 // ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-)
 192 function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
 193
 194 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
 195 // èãíîðèðóåò ðåãèñòð ñèìâîëîâ
 196 // <0: s0 < s1
 197 // =0: s0 = s1
 198 // >0: s0 > s1
 199 function SFSStrComp (const s0, s1: TSFSString): Integer;
 200
 201 // ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
 202 // èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
 203 function SFSGetLastVirtualName (const fn: TSFSString): string;
 204
 205 // ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè
 206 function Int64ToStrComma (i: Int64): string;
 207
 208 // Wildcard matching
 209 // this code is meant to allow wildcard pattern matches. tt is VERY useful
 210 // for matching filename wildcard patterns. tt allows unix grep-like pattern
 211 // comparisons, for instance:
 212 //
 213 //       ?       Matches any single characer
 214 //       +       Matches any single characer or nothing
 215 //       *       Matches any number of contiguous characters
 216 //       [abc]   Matches a or b or c at that position
 217 //       [!abc]  Matches anything but a or b or c at that position
 218 //       [a-e]   Matches a through e at that position
 219 //
 220 //       'ma?ch.*'       -Would match match.exe, mavch.dat, march.on, etc
 221 //       'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
 222 //                                 not match 'this as a yest'
 223 //
 224 function WildMatch (pattern, text: TSFSString): Boolean;
 225 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
 226 function HasWildcards (const pattern: TSFSString): Boolean;
 227
 228
 229 var
 230   // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
 231   sfsDiskEnabled: Boolean = true;
 232   // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå,
 233   // ïîòîì â ôàéëàõ äàííûõ.
 234   sfsDiskFirst: Boolean = true;
 235   // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê
 236   // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled).
 237   sfsForceDiskForPrefixed: Boolean = false;
 238   // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â
 239   // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
 240   // <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
 241   // <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
 242   sfsDiskDirs: TSFSString = '<currentdir>|<exedir>';
 243
 244
 245 implementation
 246
 247 uses
 248   xstreams;
 249
 250
 251 function Int64ToStrComma (i: Int64): string;
 252 var
 253   f: Integer;
 254 begin
 255   Str(i, result);
 256   f := Length(result)+1;
 257   while f > 4 do
 258   begin
 259     Dec(f, 3); Insert(',', result, f);
 260   end;
 261 end;
 262
 263
 264 const
 265   // character defines
 266   WILD_CHAR_ESCAPE         = '\';
 267   WILD_CHAR_SINGLE         = '?';
 268   WILD_CHAR_SINGLE_OR_NONE = '+';
 269   WILD_CHAR_MULTI          = '*';
 270   WILD_CHAR_RANGE_OPEN     = '[';
 271   WILD_CHAR_RANGE          = '-';
 272   WILD_CHAR_RANGE_CLOSE    = ']';
 273   WILD_CHAR_RANGE_NOT      = '!';
 274
 275
 276 function HasWildcards (const pattern: TSFSString): Boolean;
 277 begin
 278   result :=
 279     (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or
 280     (Pos(WILD_CHAR_SINGLE, pattern) <> 0) or
 281     (Pos(WILD_CHAR_SINGLE_OR_NONE, pattern) <> 0) or
 282     (Pos(WILD_CHAR_MULTI, pattern) <> 0) or
 283     (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0);
 284 end;
 285
 286 function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean;
 287 var
 288   rangeStart, rangeEnd: AnsiChar;
 289   rangeNot, rangeMatched: Boolean;
 290   ch: AnsiChar;
 291 begin
 292   // sanity checks
 293   if (pend < 0) or (pend > Length(pattern)) then pend := Length(pattern);
 294   if (tend < 0) or (tend > Length(text)) then tend := Length(text);
 295   if t < 1 then t := 1;
 296   if p < 1 then p := 1;
 297   while p <= pend do
 298   begin
 299     if t > tend then
 300     begin
 301       // no more text. check if there's no more chars in pattern (except "*" & "+")
 302       while (p <= pend) and
 303             ((pattern[p] = WILD_CHAR_MULTI) or
 304              (pattern[p] = WILD_CHAR_SINGLE_OR_NONE)) do Inc(p);
 305       result := (p > pend);
 306       exit;
 307     end;
 308     case pattern[p] of
 309       WILD_CHAR_SINGLE: ;
 310       WILD_CHAR_ESCAPE:
 311         begin
 312           Inc(p);
 313           if p > pend then result := false else result := (pattern[p] = text[t]);
 314           if not result then exit;
 315         end;
 316       WILD_CHAR_RANGE_OPEN:
 317         begin
 318           result := false;
 319           Inc(p); if p > pend then exit; // sanity check
 320           rangeNot := (pattern[p] = WILD_CHAR_RANGE_NOT);
 321           if rangeNot then begin Inc(p); if p > pend then exit; {sanity check} end;
 322           if pattern[p] = WILD_CHAR_RANGE_CLOSE then exit; // sanity check
 323           ch := text[t]; // speed reasons
 324           rangeMatched := false;
 325           repeat
 326             if p > pend then exit; // sanity check
 327             rangeStart := pattern[p];
 328             if rangeStart = WILD_CHAR_RANGE_CLOSE then break;
 329             Inc(p); if p > pend then exit; // sanity check
 330             if pattern[p] = WILD_CHAR_RANGE then
 331             begin
 332               Inc(p); if p > pend then exit; // sanity check
 333               rangeEnd := pattern[p]; Inc(p);
 334               if rangeStart < rangeEnd then
 335               begin
 336                 rangeMatched := (ch >= rangeStart) and (ch <= rangeEnd);
 337               end
 338               else rangeMatched := (ch >= rangeEnd) and (ch <= rangeStart);
 339             end
 340             else rangeMatched := (ch = rangeStart);
 341           until rangeMatched;
 342           if rangeNot = rangeMatched then exit;
 343
 344           // skip the rest or the range
 345           while (p <= pend) and (pattern[p] <> WILD_CHAR_RANGE_CLOSE) do Inc(p);
 346           if p > pend then exit; // sanity check
 347         end;
 348       WILD_CHAR_SINGLE_OR_NONE:
 349         begin
 350           Inc(p);
 351           result := MatchMask(pattern, p, pend, text, t, tend);
 352           if not result then result := MatchMask(pattern, p, pend, text, t+1, tend);
 353           exit;
 354         end;
 355       WILD_CHAR_MULTI:
 356         begin
 357           while (p <= pend) and (pattern[p] = WILD_CHAR_MULTI) do Inc(p);
 358           result := (p > pend); if result then exit;
 359           while not result and (t <= tend) do
 360           begin
 361             result := MatchMask(pattern, p, pend, text, t, tend);
 362             Inc(t);
 363           end;
 364           exit;
 365         end;
 366       else result := (pattern[p] = text[t]); if not result then exit;
 367     end;
 368     Inc(p); Inc(t);
 369   end;
 370   result := (t > tend);
 371 end;
 372
 373
 374 function WildMatch (pattern, text: TSFSString): Boolean;
 375 begin
 376   if pattern <> '' then pattern := AnsiLowerCase(pattern);
 377   if text <> '' then text := AnsiLowerCase(text);
 378   result := MatchMask(pattern, 1, -1, text, 1, -1);
 379 end;
 380
 381 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
 382 var
 383   s, e: Integer;
 384 begin
 385   if wildList <> '' then wildList := AnsiLowerCase(wildList);
 386   if text <> '' then text := AnsiLowerCase(text);
 387   result := 0;
 388   s := 1;
 389   while s <= Length(wildList) do
 390   begin
 391     e := s; while e <= Length(wildList) do
 392     begin
 393       if wildList[e] = WILD_CHAR_RANGE_OPEN then
 394       begin
 395         while (e <= Length(wildList)) and (wildList[e] <> WILD_CHAR_RANGE_CLOSE) do Inc(e);
 396       end;
 397       if wildList[e] = delimChar then break;
 398       Inc(e);
 399     end;
 400     if s < e then
 401     begin
 402       if MatchMask(wildList, s, e-1, text, 1, -1) then exit;
 403     end;
 404     Inc(result);
 405     s := e+1;
 406   end;
 407   result := -1;
 408 end;
 409
 410
 411 type
 412   TVolumeInfo = class
 413     fFactory: TSFSVolumeFactory;
 414     fVolume: TSFSVolume;
 415     fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
 416     fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
 417     fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
 418     // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
 419     fNoDiskFile: Boolean;
 420     fOpenedFilesCount: Integer;
 421
 422     destructor Destroy (); override;
 423   end;
 424
 425   TOwnedPartialStream = class (TSFSPartialStream)
 426   protected
 427     fOwner: TVolumeInfo;
 428
 429   public
 430     constructor Create (pOwner: TVolumeInfo; pSrc: TStream; pPos, pSize: Int64; pKillSrc: Boolean);
 431     destructor Destroy (); override;
 432   end;
 433
 434
 435 var
 436   factories: TObjectList; // TSFSVolumeFactory
 437   volumes: TObjectList;   // TVolumeInfo
 438
 439
 440 // ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
 441 // ñîáñòâåííî èìÿ ôàéëà
 442 // èìÿ âûãëÿäèò êàê:
 443 // (("sfspfx:")?"datafile::")*"filename"
 444 procedure SplitFName (const fn: string; out dataFile, fileName: string);
 445 var
 446   f: Integer;
 447 begin
 448   f := Length(fn)-1;
 449   while f >= 1 do
 450   begin
 451     if (fn[f] = ':') and (fn[f+1] = ':') then break;
 452     Dec(f);
 453   end;
 454   if f < 1 then begin dataFile := ''; fileName := fn; end
 455   else
 456   begin
 457     dataFile := Copy(fn, 1, f-1);
 458     fileName := Copy(fn, f+2, maxInt-10000);
 459   end;
 460 end;
 461
 462 // ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
 463 function ExtractVirtName (var dataFile: string): string;
 464 var
 465   f: Integer;
 466 begin
 467   f := Length(dataFile); result := dataFile;
 468   while f > 1 do
 469   begin
 470     if dataFile[f] = ':' then break;
 471     if dataFile[f] = '|' then
 472     begin
 473       if dataFile[f-1] = '|' then begin Dec(f); Delete(dataFile, f, 1); end
 474       else
 475       begin
 476         result := Copy(dataFile, f+1, Length(dataFile));
 477         Delete(dataFile, f, Length(dataFile));
 478         break;
 479       end;
 480     end;
 481     Dec(f);
 482   end;
 483 end;
 484
 485 // ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
 486 // âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile.
 487 // èìÿ âûãëÿäèò êàê:
 488 // [sfspfx:]datafile[|virtname]
 489 // åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
 490 // à èìåíåì äèñêà.
 491 procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string);
 492 var
 493   f: Integer;
 494 begin
 495   f := Pos(':', fn);
 496   if f <= 3 then begin pfx := ''; dataFile := fn; end
 497   else
 498   begin
 499     pfx := Copy(fn, 1, f-1);
 500     dataFile := Copy(fn, f+1, maxInt-10000);
 501   end;
 502   virtName := ExtractVirtName(dataFile);
 503 end;
 504
 505 // íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
 506 // onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
 507 function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer;
 508 var
 509   f: Integer;
 510   vi: TVolumeInfo;
 511 begin
 512   f := 0;
 513   while f < volumes.Count do
 514   begin
 515     if volumes[f] <> nil then
 516     begin
 517       vi := TVolumeInfo(volumes[f]);
 518       if not onlyPerm or vi.fPermanent then
 519       begin
 520         if SFSStrComp(vi.fPackName, dataFileName) = 0 then
 521         begin
 522           result := f;
 523           exit;
 524         end;
 525       end;
 526     end;
 527     Inc(f);
 528   end;
 529   result := -1;
 530 end;
 531
 532 // íàéòè èíôó äëÿ ýòîãî òîìà.
 533 // õîðîøåå èìÿ, ïðàâäà? %-)
 534 function FindVolumeInfoByVolumeInstance (vol: TSFSVolume): Integer;
 535 begin
 536   result := volumes.Count-1;
 537   while result >= 0 do
 538   begin
 539     if volumes[result] <> nil then
 540     begin
 541       if TVolumeInfo(volumes[result]).fVolume = vol then exit;
 542     end;
 543     Dec(result);
 544   end;
 545 end;
 546
 547 // <0: s0 < s1
 548 // =0: s0 = s1
 549 // >0: s0 > s1
 550 function SFSStrComp (const s0, s1: TSFSString): Integer;
 551 begin
 552   result := AnsiCompareText(s0, s1);
 553 end;
 554
 555 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
 556 var
 557   f: Integer;
 558 begin
 559   result := s;
 560   for f := 1 to Length(result) do
 561   begin
 562     if (result[f] = '/') or (result[f] = '\') then
 563     begin
 564       // avoid unnecessary string changes
 565       if result[f] <> newDelim then result[f] := newDelim;
 566     end;
 567   end;
 568 end;
 569
 570 function SFSGetLastVirtualName (const fn: TSFSString): string;
 571 var
 572   rest, tmp: string;
 573   f: Integer;
 574 begin
 575   rest := fn;
 576   repeat
 577     f := Pos('::', rest); if f = 0 then f := Length(rest)+1;
 578     tmp := Copy(rest, 1, f-1); Delete(rest, 1, f+1);
 579     result := ExtractVirtName(tmp);
 580   until rest = '';
 581 end;
 582
 583
 584 { TVolumeInfo }
 585 destructor TVolumeInfo.Destroy ();
 586 var
 587   f, me: Integer;
 588   used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
 589 begin
 590   if fFactory <> nil then fFactory.Recycle(fVolume);
 591   fVolume := nil; fFactory := nil; fPackName := '';
 592
 593   // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ,
 594   // òî óãðîáèòü åãî íàôèã.
 595   me := volumes.IndexOf(self);
 596   used := false;
 597   f := volumes.Count-1;
 598   while not used and (f >= 0) do
 599   begin
 600     if (f <> me) and (volumes[f] <> nil) then
 601     begin
 602       used := (TVolumeInfo(volumes[f]).fStream = fStream);
 603       if not used then
 604         used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream);
 605     end;
 606     Dec(f);
 607   end;
 608   if not used then FreeAndNil(fStream); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì
 609   inherited Destroy();
 610 end;
 611
 612
 613 { TOwnedPartialStream }
 614 constructor TOwnedPartialStream.Create (pOwner: TVolumeInfo; pSrc: TStream;
 615   pPos, pSize: Int64; pKillSrc: Boolean);
 616 begin
 617   inherited Create(pSrc, pPos, pSize, pKillSrc);
 618   fOwner := pOwner;
 619   if pOwner <> nil then Inc(pOwner.fOpenedFilesCount);
 620 end;
 621
 622 destructor TOwnedPartialStream.Destroy ();
 623 var
 624   f: Integer;
 625 begin
 626   inherited Destroy();
 627   if fOwner <> nil then
 628   begin
 629     Dec(fOwner.fOpenedFilesCount);
 630     if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then
 631     begin
 632       f := volumes.IndexOf(fOwner);
 633       if f <> -1 then volumes[f] := nil; // this will destroy the volume
 634     end;
 635   end;
 636 end;
 637
 638
 639 { TSFSFileInfo }
 640 constructor TSFSFileInfo.Create (pOwner: TSFSVolume);
 641 begin
 642   inherited Create();
 643   fOwner := pOwner;
 644   fPath := ''; fName := '';
 645   fSize := 0; fOfs := 0;
 646   if pOwner <> nil then pOwner.fFiles.Add(self);
 647 end;
 648
 649 destructor TSFSFileInfo.Destroy ();
 650 begin
 651   if fOwner <> nil then fOwner.fFiles.Extract(self);
 652   inherited Destroy();
 653 end;
 654
 655
 656 { TSFSVolume }
 657 constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream);
 658 begin
 659   inherited Create();
 660   fFileStream := pSt;
 661   fFileName := pFileName;
 662   fFiles := TObjectList.Create(true);
 663 end;
 664
 665 procedure TSFSVolume.DoDirectoryRead ();
 666 var
 667   fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so!
 668   f, c, n: Integer;
 669   sfi: TSFSFileInfo;
 670   tmp, fn, ext: TSFSString;
 671 begin
 672   fl := nil;
 673   fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
 674   try
 675     ReadDirectory();
 676     fFiles.Pack();
 677
 678     // check for duplicate file names
 679     fl := TStringList.Create(); fl.Sorted := true;
 680     for f := 0 to fFiles.Count-1 do
 681     begin
 682       sfi := TSFSFileInfo(fFiles[f]);
 683
 684       // normalize name & path
 685       sfi.fPath := SFSReplacePathDelims(sfi.fPath, '/');
 686       if (sfi.fPath <> '') and (sfi.fPath[1] = '/') then Delete(sfi.fPath, 1, 1);
 687       if (sfi.fPath <> '') and (sfi.fPath[Length(sfi.fPath)] <> '/') then sfi.fPath := sfi.fPath+'/';
 688       tmp := SFSReplacePathDelims(sfi.fName, '/');
 689       c := Length(tmp); while (c > 0) and (tmp[c] <> '/') do Dec(c);
 690       if c > 0 then
 691       begin
 692         // split path and name
 693         Delete(sfi.fName, 1, c); // cut name
 694         tmp := Copy(tmp, 1, c);  // get path
 695         if tmp = '/' then tmp := ''; // just delimiter; ignore it
 696         sfi.fPath := sfi.fPath+tmp;
 697       end;
 698
 699       // check for duplicates
 700       if fl.Find(sfi.fPath+sfi.fName, c) then
 701       begin
 702         n := 0; tmp := sfi.fName;
 703         c := Length(tmp); while (c > 0) and (tmp[c] <> '.') do Dec(c);
 704         if c < 1 then c := Length(tmp)+1;
 705         fn := Copy(tmp, 1, c-1); ext := Copy(tmp, c, Length(tmp));
 706         repeat
 707           tmp := fn+'_'+IntToStr(n)+ext;
 708           if not fl.Find(sfi.fPath+tmp, c) then break;
 709           Inc(n);
 710         until false;
 711         sfi.fName := tmp;
 712       end;
 713       fl.Add(sfi.fName);
 714     end;
 715     fl.Free();
 716   except
 717     fl.Free();
 718     raise;
 719   end;
 720 end;
 721
 722 destructor TSFSVolume.Destroy ();
 723 begin
 724   Clear();
 725   FreeAndNil(fFiles);
 726   inherited Destroy();
 727 end;
 728
 729 procedure TSFSVolume.Clear ();
 730 begin
 731   fFiles.Clear();
 732 end;
 733
 734 function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer;
 735 begin
 736   if fFiles = nil then result := -1
 737   else
 738   begin
 739     result := fFiles.Count;
 740     while result > 0 do
 741     begin
 742       Dec(result);
 743       if fFiles[result] <> nil then
 744       begin
 745         if (SFSStrComp(fPath, TSFSFileInfo(fFiles[result]).fPath) = 0) and
 746            (SFSStrComp(fName, TSFSFileInfo(fFiles[result]).fName) = 0) then exit;
 747       end;
 748     end;
 749     result := -1;
 750   end;
 751 end;
 752
 753 function TSFSVolume.GetFileCount (): Integer;
 754 begin
 755   if fFiles = nil then result := 0 else result := fFiles.Count;
 756 end;
 757
 758 function TSFSVolume.GetFiles (index: Integer): TSFSFileInfo;
 759 begin
 760   if fFiles = nil then result := nil
 761   else
 762   begin
 763     if (index < 0) or (index >= fFiles.Count) then result := nil
 764     else result := TSFSFileInfo(fFiles[index]);
 765   end;
 766 end;
 767
 768 function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream;
 769 var
 770   fp, fn: TSFSString;
 771   f, ls: Integer;
 772 begin
 773   fp := fName;
 774   // normalize name, find split position
 775   if (fp <> '') and ((fp[1] = '/') or (fp[1] = '\')) then Delete(fp, 1, 1);
 776   ls := 0;
 777   for f := 1 to Length(fp) do
 778   begin
 779     if fp[f] = '\' then fp[f] := '/';
 780     if fp[f] = '/' then ls := f;
 781   end;
 782   fn := Copy(fp, ls+1, Length(fp));
 783   fp := Copy(fp, 1, ls);
 784   f := FindFile(fp, fn);
 785   if f = -1 then raise ESFSError.Create('file not found: "'+fName+'"');
 786   result := OpenFileByIndex(f);
 787   if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
 788 end;
 789
 790
 791 { TSFSFileList }
 792 constructor TSFSFileList.Create (const pVolume: TSFSVolume);
 793 var
 794   f: Integer;
 795 begin
 796   inherited Create();
 797   ASSERT(pVolume <> nil);
 798   f := FindVolumeInfoByVolumeInstance(pVolume);
 799   ASSERT(f <> -1);
 800   fVolume := pVolume;
 801   Inc(TVolumeInfo(volumes[f]).fOpenedFilesCount); // íå ïîçâîëèì óáèòü çàïèñü!
 802 end;
 803
 804 destructor TSFSFileList.Destroy ();
 805 var
 806   f: Integer;
 807 begin
 808   f := FindVolumeInfoByVolumeInstance(fVolume);
 809   ASSERT(f <> -1);
 810   Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
 811   // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
 812   if not TVolumeInfo(volumes[f]).fPermanent and
 813      (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then volumes[f] := nil;
 814   inherited Destroy();
 815 end;
 816
 817 function TSFSFileList.GetCount (): Integer;
 818 begin
 819   result := fVolume.fFiles.Count;
 820 end;
 821
 822 function TSFSFileList.GetFiles (index: Integer): TSFSFileInfo;
 823 begin
 824   if (index < 0) or (index >= fVolume.fFiles.Count) then result := nil
 825   else result := TSFSFileInfo(fVolume.fFiles[index]);
 826 end;
 827
 828
 829 procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
 830 var
 831   f: Integer;
 832 begin
 833   if factory = nil then exit;
 834   if factories.IndexOf(factory) <> -1 then
 835     raise ESFSError.Create('duplicate factories are not allowed');
 836   f := factories.IndexOf(nil);
 837   if f = -1 then factories.Add(factory) else factories[f] := factory;
 838 end;
 839
 840 procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
 841 var
 842   f: Integer;
 843   c: Integer;
 844 begin
 845   if factory = nil then exit;
 846   f := factories.IndexOf(factory);
 847   if f = -1 then raise ESFSError.Create('can''t unregister nonexisting factory');
 848   c := 0; while c < volumes.Count do
 849   begin
 850     if (volumes[c] <> nil) and (TVolumeInfo(volumes[c]).fFactory = factory) then volumes[c] := nil;
 851     Inc(c);
 852   end;
 853   factories[f] := nil;
 854 end;
 855
 856
 857 function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream;
 858   top, permanent: Integer): Integer;
 859 // dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
 860 // ìîæåò âûêèíóòü èñêëþ÷åíèå!
 861 // top:
 862 //   <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
 863 //   =0: íå ìåíÿòü.
 864 //   >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà.
 865 // permanent:
 866 //   <0: ñîçäàòü "âðåìåííûé" òîì.
 867 //   =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà.
 868 //   >0: ñîçäàòü "ïîñòîÿííûé" òîì.
 869 // åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì
 870 // dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã.
 871 // âîçâðàùàåò èíäåêñ â volumes.
 872 // óìååò äåëàòü ðåêóðñèþ.
 873 var
 874   fac: TSFSVolumeFactory;
 875   vol: TSFSVolume;
 876   vi: TVolumeInfo;
 877   f: Integer;
 878   st, st1: TStream;
 879   pfx: TSFSString;
 880   fn, vfn, tmp: TSFSString;
 881 begin
 882   f := Pos('::', dataFileName);
 883   if f <> 0 then
 884   begin
 885     // ðåêóðñèâíîå îòêðûòèå.
 886     // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê.
 887     // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì.
 888     pfx := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f+1);
 889     // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê...
 890     result := SFSAddDataFileEx(pfx, ds, 0, 0);
 891     // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì.
 892     // óçíàåì, êàêîå ôàéëî îòêðûâàòü.
 893     // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà).
 894     f := Pos('::', dataFileName); if f = 0 then f := Length(dataFileName)+1;
 895     fn := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f-1);
 896     // dataFileName õðàíèò îñòàòîê.
 897     // èçâëå÷¸ì èìÿ ôàéëà:
 898     SplitDataName(fn, pfx, tmp, vfn);
 899     // îòêðîåì ýòîò ôàéë
 900     vi := TVolumeInfo(volumes[result]); st := nil;
 901     try
 902       st := vi.fVolume.OpenFileEx(tmp);
 903       st1 := TOwnedPartialStream.Create(vi, st, 0, st.Size, true);
 904     except
 905       FreeAndNil(st);
 906       // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì.
 907       if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil;
 908       raise;
 909     end;
 910     // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå.
 911     fn := fn+dataFileName;
 912     try
 913       st1.Position := 0;
 914       result := SFSAddDataFileEx(fn, st1, top, permanent);
 915     except
 916       st1.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè.
 917       raise;
 918     end;
 919     exit;
 920   end;
 921
 922   // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå.
 923   SplitDataName(dataFileName, pfx, fn, vfn);
 924
 925   f := FindVolumeInfo(vfn);
 926   if f <> -1 then
 927   begin
 928     if ds <> nil then raise ESFSError.Create('subdata name conflict');
 929     if permanent <> 0 then TVolumeInfo(volumes[f]).fPermanent := (permanent > 0);
 930     if top = 0 then result := f
 931     else if top < 0 then result := 0
 932     else result := volumes.Count-1;
 933     if result <> f then volumes.Move(f, result);
 934     exit;
 935   end;
 936
 937   if ds <> nil then st := ds
 938   else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
 939   st.Position := 0;
 940
 941   volumes.Pack();
 942
 943   fac := nil; vol := nil;
 944   try
 945     for f := 0 to factories.Count-1 do
 946     begin
 947       fac := TSFSVolumeFactory(factories[f]);
 948       if fac = nil then continue;
 949       if (pfx <> '') and not fac.IsMyVolumePrefix(pfx) then continue;
 950       st.Position := 0;
 951       try
 952         if ds <> nil then vol := fac.Produce(pfx, '', st)
 953         else vol := fac.Produce(pfx, fn, st);
 954       except
 955         vol := nil;
 956       end;
 957       if vol <> nil then break;
 958     end;
 959     if vol = nil then raise ESFSError.Create('no factory for "'+dataFileName+'"');
 960   except
 961     if st <> ds then st.Free();
 962     raise;
 963   end;
 964
 965   vi := TVolumeInfo.Create();
 966   try
 967     if top < 0 then
 968     begin
 969       result := 0;
 970       volumes.Insert(0, vi);
 971     end
 972     else result := volumes.Add(vi);
 973   except
 974     vol.Free();
 975     if st <> ds then st.Free();
 976     vi.Free();
 977     raise;
 978   end;
 979
 980   vi.fFactory := fac;
 981   vi.fVolume := vol;
 982   vi.fPackName := vfn;
 983   vi.fStream := st;
 984   vi.fPermanent := (permanent > 0);
 985   vi.fNoDiskFile := (ds <> nil);
 986   vi.fOpenedFilesCount := 0;
 987 end;
 988
 989 function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream;
 990   top: Boolean = false): Boolean;
 991 var
 992   tv: Integer;
 993 begin
 994   ASSERT(ds <> nil);
 995   try
 996     if top then tv := -1 else tv := 1;
 997     SFSAddDataFileEx(virtualName, ds, tv, 0);
 998     result := true;
 999   except
1000     result := false;
1001   end;
1002 end;
1003
1004 function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean = false): Boolean;
1005 var
1006   tv: Integer;
1007 begin
1008   try
1009     if top then tv := -1 else tv := 1;
1010     SFSAddDataFileEx(dataFileName, nil, tv, 1);
1011     result := true;
1012   except
1013     result := false;
1014   end;
1015 end;
1016
1017
1018 function SFSExpandDirName (const s: TSFSString): TSFSString;
1019 var
1020   f, e: Integer;
1021   es: TSFSString;
1022 begin
1023   f := 1; result := s;
1024   while f < Length(result) do
1025   begin
1026     while (f < Length(result)) and (result[f] <> '<') do Inc(f);
1027     if f >= Length(result) then exit;
1028     e := f; while (e < Length(result)) and (result[e] <> '>') do Inc(e);
1029     es := Copy(result, f, e+1-f);
1030
1031     if es = '<currentdir>' then es := GetCurrentDir
1032     else if es = '<exedir>' then es := ExtractFilePath(ParamStr(0))
1033     else es := '';
1034
1035     if es <> '' then
1036     begin
1037       if (es[Length(es)] <> '/') and (es[Length(es)] <> '\') then es := es+'/';
1038       Delete(result, f, e+1-f);
1039       Insert(es, result, f);
1040       Inc(f, Length(es));
1041     end
1042     else f := e+1;
1043   end;
1044 end;
1045
1046 function SFSFileOpenEx (const fName: TSFSString): TStream;
1047 var
1048   dataFileName, fn: TSFSString;
1049   f: Integer;
1050   vi: TVolumeInfo;
1051   diskChecked: Boolean;
1052   ps: TStream;
1053
1054   function CheckDisk (): TStream;
1055   // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
1056   var
1057     dfn, dirs, cdir: TSFSString;
1058     f: Integer;
1059   begin
1060     result := nil;
1061     if diskChecked or not sfsDiskEnabled then exit;
1062     diskChecked := true;
1063     dfn := SFSReplacePathDelims(fn, '/');
1064     dirs := sfsDiskDirs; if dirs = '' then dirs := '<currentdir>';
1065     while dirs <> '' do
1066     begin
1067       f := 1; while (f <= Length(dirs)) and (dirs[f] <> '|') do Inc(f);
1068       cdir := Copy(dirs, 1, f-1); Delete(dirs, 1, f);
1069       if cdir = '' then continue;
1070       cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/');
1071       if cdir[Length(cdir)] <> '/' then cdir := cdir+'/';
1072       try
1073         result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite);
1074         exit;
1075       except
1076       end;
1077     end;
1078   end;
1079
1080 begin
1081   SplitFName(fName, dataFileName, fn);
1082   if fn = '' then raise ESFSError.Create('invalid file name: "'+fName+'"');
1083
1084   diskChecked := false;
1085
1086   if dataFileName <> '' then
1087   begin
1088     // ïðåôèêñîâàíûé ôàéë
1089     if sfsForceDiskForPrefixed then
1090     begin
1091       result := CheckDisk();
1092       if result <> nil then exit;
1093     end;
1094
1095     f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1096     vi := TVolumeInfo(volumes[f]);
1097
1098     try
1099       result := vi.fVolume.OpenFileEx(fn);
1100       ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1101     except
1102       result.Free();
1103       if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1104       result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê
1105       if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1106       exit;
1107     end;
1108     //Inc(vi.fOpenedFilesCount);
1109     result := ps;
1110     exit;
1111   end;
1112
1113   // íåïðåôèêñîâàíûé ôàéë
1114   if sfsDiskFirst then
1115   begin
1116     result := CheckDisk();
1117     if result <> nil then exit;
1118   end;
1119   // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì
1120   f := 0;
1121   while f < volumes.Count do
1122   begin
1123     vi := TVolumeInfo(volumes[f]);
1124     if (vi <> nil) and vi.fPermanent then
1125     begin
1126       if vi.fVolume <> nil then
1127       begin
1128         result := vi.fVolume.OpenFileEx(fn);
1129         if result <> nil then
1130         begin
1131           try
1132             ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1133             result := ps;
1134             //Inc(vi.fOpenedFilesCount);
1135           except
1136             FreeAndNil(result);
1137           end;
1138         end;
1139         if result <> nil then exit;
1140       end;
1141     end;
1142     Inc(f);
1143   end;
1144   result := CheckDisk();
1145   if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1146 end;
1147
1148 function SFSFileOpen (const fName: TSFSString): TStream;
1149 begin
1150   try
1151     result := SFSFileOpenEx(fName);
1152   except
1153     result := nil;
1154   end;
1155 end;
1156
1157 function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
1158 var
1159   f: Integer;
1160   vi: TVolumeInfo;
1161 begin
1162   result := nil;
1163   if dataFileName = '' then exit;
1164
1165   try
1166     f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1167   except
1168     exit;
1169   end;
1170   vi := TVolumeInfo(volumes[f]);
1171
1172   try
1173     result := TSFSFileList.Create(vi.fVolume);
1174   except
1175     if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1176   end;
1177 end;
1178
1179
1180 initialization
1181   factories := TObjectList.Create(true);
1182   volumes := TObjectList.Create(true);
1183 finalization
1184   //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?!
1185   //factories.Free(); // not need to be done actually...
1186 end.