src/sfs/sfs.pas

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