DEADSOFTWARE

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