src/sfs/sfs.pas

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