src/sfs/sfs.pas

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