src/sfs/sfs.pas

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