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