DEADSOFTWARE

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