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