src/sfs/sfs.pas

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