DEADSOFTWARE

sfs: remove common dir from pk3 (this should fix invalid zips)
[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 // Wildcard matching
210 // this code is meant to allow wildcard pattern matches. tt is VERY useful
211 // for matching filename wildcard patterns. tt allows unix grep-like pattern
212 // comparisons, for instance:
213 //
214 // ? Matches any single characer
215 // + Matches any single characer or nothing
216 // * Matches any number of contiguous characters
217 // [abc] Matches a or b or c at that position
218 // [!abc] Matches anything but a or b or c at that position
219 // [a-e] Matches a through e at that position
220 //
221 // 'ma?ch.*' -Would match match.exe, mavch.dat, march.on, etc
222 // 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
223 // not match 'this as a yest'
224 //
225 function WildMatch (pattern, text: TSFSString): Boolean;
226 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
227 function HasWildcards (const pattern: TSFSString): Boolean;
229 // this will compare only last path element from sfspath
230 function SFSDFPathEqu (sfspath: string; path: string): Boolean;
232 function SFSUpCase (ch: Char): Char;
235 var
236 // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
237 sfsDiskEnabled: Boolean = true;
238 // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå,
239 // ïîòîì â ôàéëàõ äàííûõ.
240 sfsDiskFirst: Boolean = true;
241 // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê
242 // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled).
243 sfsForceDiskForPrefixed: Boolean = false;
244 // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â
245 // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
246 // <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
247 // <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
248 sfsDiskDirs: TSFSString = '<currentdir>|<exedir>';
251 implementation
253 uses
254 xstreams;
257 function Int64ToStrComma (i: Int64): string;
258 var
259 f: Integer;
260 begin
261 Str(i, result);
262 f := Length(result)+1;
263 while f > 4 do
264 begin
265 Dec(f, 3); Insert(',', result, f);
266 end;
267 end;
270 const
271 // character defines
272 WILD_CHAR_ESCAPE = '\';
273 WILD_CHAR_SINGLE = '?';
274 WILD_CHAR_SINGLE_OR_NONE = '+';
275 WILD_CHAR_MULTI = '*';
276 WILD_CHAR_RANGE_OPEN = '[';
277 WILD_CHAR_RANGE = '-';
278 WILD_CHAR_RANGE_CLOSE = ']';
279 WILD_CHAR_RANGE_NOT = '!';
282 function HasWildcards (const pattern: TSFSString): Boolean;
283 begin
284 result :=
285 (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or
286 (Pos(WILD_CHAR_SINGLE, pattern) <> 0) or
287 (Pos(WILD_CHAR_SINGLE_OR_NONE, pattern) <> 0) or
288 (Pos(WILD_CHAR_MULTI, pattern) <> 0) or
289 (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0);
290 end;
292 function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean;
293 var
294 rangeStart, rangeEnd: AnsiChar;
295 rangeNot, rangeMatched: Boolean;
296 ch: AnsiChar;
297 begin
298 // sanity checks
299 if (pend < 0) or (pend > Length(pattern)) then pend := Length(pattern);
300 if (tend < 0) or (tend > Length(text)) then tend := Length(text);
301 if t < 1 then t := 1;
302 if p < 1 then p := 1;
303 while p <= pend do
304 begin
305 if t > tend then
306 begin
307 // no more text. check if there's no more chars in pattern (except "*" & "+")
308 while (p <= pend) and
309 ((pattern[p] = WILD_CHAR_MULTI) or
310 (pattern[p] = WILD_CHAR_SINGLE_OR_NONE)) do Inc(p);
311 result := (p > pend);
312 exit;
313 end;
314 case pattern[p] of
315 WILD_CHAR_SINGLE: ;
316 WILD_CHAR_ESCAPE:
317 begin
318 Inc(p);
319 if p > pend then result := false else result := (pattern[p] = text[t]);
320 if not result then exit;
321 end;
322 WILD_CHAR_RANGE_OPEN:
323 begin
324 result := false;
325 Inc(p); if p > pend then exit; // sanity check
326 rangeNot := (pattern[p] = WILD_CHAR_RANGE_NOT);
327 if rangeNot then begin Inc(p); if p > pend then exit; {sanity check} end;
328 if pattern[p] = WILD_CHAR_RANGE_CLOSE then exit; // sanity check
329 ch := text[t]; // speed reasons
330 rangeMatched := false;
331 repeat
332 if p > pend then exit; // sanity check
333 rangeStart := pattern[p];
334 if rangeStart = WILD_CHAR_RANGE_CLOSE then break;
335 Inc(p); if p > pend then exit; // sanity check
336 if pattern[p] = WILD_CHAR_RANGE then
337 begin
338 Inc(p); if p > pend then exit; // sanity check
339 rangeEnd := pattern[p]; Inc(p);
340 if rangeStart < rangeEnd then
341 begin
342 rangeMatched := (ch >= rangeStart) and (ch <= rangeEnd);
343 end
344 else rangeMatched := (ch >= rangeEnd) and (ch <= rangeStart);
345 end
346 else rangeMatched := (ch = rangeStart);
347 until rangeMatched;
348 if rangeNot = rangeMatched then exit;
350 // skip the rest or the range
351 while (p <= pend) and (pattern[p] <> WILD_CHAR_RANGE_CLOSE) do Inc(p);
352 if p > pend then exit; // sanity check
353 end;
354 WILD_CHAR_SINGLE_OR_NONE:
355 begin
356 Inc(p);
357 result := MatchMask(pattern, p, pend, text, t, tend);
358 if not result then result := MatchMask(pattern, p, pend, text, t+1, tend);
359 exit;
360 end;
361 WILD_CHAR_MULTI:
362 begin
363 while (p <= pend) and (pattern[p] = WILD_CHAR_MULTI) do Inc(p);
364 result := (p > pend); if result then exit;
365 while not result and (t <= tend) do
366 begin
367 result := MatchMask(pattern, p, pend, text, t, tend);
368 Inc(t);
369 end;
370 exit;
371 end;
372 else result := (pattern[p] = text[t]); if not result then exit;
373 end;
374 Inc(p); Inc(t);
375 end;
376 result := (t > tend);
377 end;
380 function WildMatch (pattern, text: TSFSString): Boolean;
381 begin
382 if pattern <> '' then pattern := AnsiLowerCase(pattern);
383 if text <> '' then text := AnsiLowerCase(text);
384 result := MatchMask(pattern, 1, -1, text, 1, -1);
385 end;
387 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
388 var
389 s, e: Integer;
390 begin
391 if wildList <> '' then wildList := AnsiLowerCase(wildList);
392 if text <> '' then text := AnsiLowerCase(text);
393 result := 0;
394 s := 1;
395 while s <= Length(wildList) do
396 begin
397 e := s; while e <= Length(wildList) do
398 begin
399 if wildList[e] = WILD_CHAR_RANGE_OPEN then
400 begin
401 while (e <= Length(wildList)) and (wildList[e] <> WILD_CHAR_RANGE_CLOSE) do Inc(e);
402 end;
403 if wildList[e] = delimChar then break;
404 Inc(e);
405 end;
406 if s < e then
407 begin
408 if MatchMask(wildList, s, e-1, text, 1, -1) then exit;
409 end;
410 Inc(result);
411 s := e+1;
412 end;
413 result := -1;
414 end;
417 type
418 TVolumeInfo = class
419 fFactory: TSFSVolumeFactory;
420 fVolume: TSFSVolume;
421 fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
422 fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
423 fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
424 // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
425 fNoDiskFile: Boolean;
426 fOpenedFilesCount: Integer;
428 destructor Destroy (); override;
429 end;
431 TOwnedPartialStream = class (TSFSPartialStream)
432 protected
433 fOwner: TVolumeInfo;
435 public
436 constructor Create (pOwner: TVolumeInfo; pSrc: TStream; pPos, pSize: Int64; pKillSrc: Boolean);
437 destructor Destroy (); override;
438 end;
441 var
442 factories: TObjectList; // TSFSVolumeFactory
443 volumes: TObjectList; // TVolumeInfo
446 // ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
447 // ñîáñòâåííî èìÿ ôàéëà
448 // èìÿ âûãëÿäèò êàê:
449 // (("sfspfx:")?"datafile::")*"filename"
450 procedure SplitFName (const fn: string; out dataFile, fileName: string);
451 var
452 f: Integer;
453 begin
454 f := Length(fn)-1;
455 while f >= 1 do
456 begin
457 if (fn[f] = ':') and (fn[f+1] = ':') then break;
458 Dec(f);
459 end;
460 if f < 1 then begin dataFile := ''; fileName := fn; end
461 else
462 begin
463 dataFile := Copy(fn, 1, f-1);
464 fileName := Copy(fn, f+2, maxInt-10000);
465 end;
466 end;
468 // ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
469 function ExtractVirtName (var dataFile: string): string;
470 var
471 f: Integer;
472 begin
473 f := Length(dataFile); result := dataFile;
474 while f > 1 do
475 begin
476 if dataFile[f] = ':' then break;
477 if dataFile[f] = '|' then
478 begin
479 if dataFile[f-1] = '|' then begin Dec(f); Delete(dataFile, f, 1); end
480 else
481 begin
482 result := Copy(dataFile, f+1, Length(dataFile));
483 Delete(dataFile, f, Length(dataFile));
484 break;
485 end;
486 end;
487 Dec(f);
488 end;
489 end;
491 // ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
492 // âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile.
493 // èìÿ âûãëÿäèò êàê:
494 // [sfspfx:]datafile[|virtname]
495 // åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
496 // à èìåíåì äèñêà.
497 procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string);
498 var
499 f: Integer;
500 begin
501 f := Pos(':', fn);
502 if f <= 3 then begin pfx := ''; dataFile := fn; end
503 else
504 begin
505 pfx := Copy(fn, 1, f-1);
506 dataFile := Copy(fn, f+1, maxInt-10000);
507 end;
508 virtName := ExtractVirtName(dataFile);
509 end;
511 // íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
512 // onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
513 function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer;
514 var
515 f: Integer;
516 vi: TVolumeInfo;
517 begin
518 f := 0;
519 while f < volumes.Count do
520 begin
521 if volumes[f] <> nil then
522 begin
523 vi := TVolumeInfo(volumes[f]);
524 if not onlyPerm or vi.fPermanent then
525 begin
526 if SFSStrEqu(vi.fPackName, dataFileName) then
527 begin
528 result := f;
529 exit;
530 end;
531 end;
532 end;
533 Inc(f);
534 end;
535 result := -1;
536 end;
538 // íàéòè èíôó äëÿ ýòîãî òîìà.
539 // õîðîøåå èìÿ, ïðàâäà? %-)
540 function FindVolumeInfoByVolumeInstance (vol: TSFSVolume): Integer;
541 begin
542 result := volumes.Count-1;
543 while result >= 0 do
544 begin
545 if volumes[result] <> nil then
546 begin
547 if TVolumeInfo(volumes[result]).fVolume = vol then exit;
548 end;
549 Dec(result);
550 end;
551 end;
553 function SFSUpCase (ch: Char): Char;
554 begin
555 if ch < #128 then
556 begin
557 if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32);
558 end
559 else
560 begin
561 if (ch >= #224) and (ch <= #255) then
562 begin
563 Dec(ch, 32);
564 end
565 else
566 begin
567 case ch of
568 #184, #186, #191: Dec(ch, 16);
569 #162, #179: Dec(ch);
570 end;
571 end;
572 end;
573 result := ch;
574 end;
576 function SFSStrEqu (const s0, s1: TSFSString): Boolean;
577 var
578 i: Integer;
579 begin
580 //result := (AnsiCompareText(s0, s1) == 0);
581 result := false;
582 if length(s0) <> length(s1) then exit;
583 for i := 1 to length(s0) do
584 begin
585 if SFSUpCase(s0[i]) <> SFSUpCase(s1[i]) then exit;
586 end;
587 result := true;
588 end;
590 // this will compare only last path element from sfspath
591 function SFSDFPathEqu (sfspath: string; path: string): Boolean;
592 {var
593 i: Integer;}
594 begin
595 result := SFSStrEqu(sfspath, path);
596 (*
597 if not result and (length(sfspath) > 1) then
598 begin
599 i := length(sfspath);
600 while i > 1 do
601 begin
602 while (i > 1) and (sfspath[i-1] <> '/') do Dec(i);
603 if i <= 1 then exit;
604 writeln('{', sfspath, '} [', Copy(sfspath, i, length(sfspath)), '] : [', path, ']');
605 result := SFSStrEqu(Copy(sfspath, i, length(sfspath)), path);
606 end;
607 end;
608 *)
609 end;
611 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
612 var
613 f: Integer;
614 begin
615 result := s;
616 for f := 1 to Length(result) do
617 begin
618 if (result[f] = '/') or (result[f] = '\') then
619 begin
620 // avoid unnecessary string changes
621 if result[f] <> newDelim then result[f] := newDelim;
622 end;
623 end;
624 end;
626 function SFSGetLastVirtualName (const fn: TSFSString): string;
627 var
628 rest, tmp: string;
629 f: Integer;
630 begin
631 rest := fn;
632 repeat
633 f := Pos('::', rest); if f = 0 then f := Length(rest)+1;
634 tmp := Copy(rest, 1, f-1); Delete(rest, 1, f+1);
635 result := ExtractVirtName(tmp);
636 until rest = '';
637 end;
640 { TVolumeInfo }
641 destructor TVolumeInfo.Destroy ();
642 var
643 f, me: Integer;
644 used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
645 begin
646 if fFactory <> nil then fFactory.Recycle(fVolume);
647 if fVolume <> nil then used := (fVolume.fRC <> 0) else used := false;
648 fVolume := nil;
649 fFactory := nil;
650 fPackName := '';
652 // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ, òî óãðîáèòü åãî íàôèã
653 if not used then
654 begin
655 me := volumes.IndexOf(self);
656 f := volumes.Count-1;
657 while not used and (f >= 0) do
658 begin
659 if (f <> me) and (volumes[f] <> nil) then
660 begin
661 used := (TVolumeInfo(volumes[f]).fStream = fStream);
662 if not used then
663 begin
664 used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream);
665 end;
666 if used then break;
667 end;
668 Dec(f);
669 end;
670 end;
671 if not used then FreeAndNil(fStream); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì
672 inherited Destroy();
673 end;
676 { TOwnedPartialStream }
677 constructor TOwnedPartialStream.Create (pOwner: TVolumeInfo; pSrc: TStream;
678 pPos, pSize: Int64; pKillSrc: Boolean);
679 begin
680 inherited Create(pSrc, pPos, pSize, pKillSrc);
681 fOwner := pOwner;
682 if pOwner <> nil then Inc(pOwner.fOpenedFilesCount);
683 end;
685 destructor TOwnedPartialStream.Destroy ();
686 var
687 f: Integer;
688 begin
689 inherited Destroy();
690 if fOwner <> nil then
691 begin
692 Dec(fOwner.fOpenedFilesCount);
693 if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then
694 begin
695 f := volumes.IndexOf(fOwner);
696 if f <> -1 then volumes[f] := nil; // this will destroy the volume
697 end;
698 end;
699 end;
702 { TSFSFileInfo }
703 constructor TSFSFileInfo.Create (pOwner: TSFSVolume);
704 begin
705 inherited Create();
706 fOwner := pOwner;
707 fPath := '';
708 fName := '';
709 fSize := 0;
710 fOfs := 0;
711 if pOwner <> nil then pOwner.fFiles.Add(self);
712 end;
714 destructor TSFSFileInfo.Destroy ();
715 begin
716 if fOwner <> nil then fOwner.fFiles.Extract(self);
717 inherited Destroy();
718 end;
721 { TSFSVolume }
722 constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream);
723 begin
724 inherited Create();
725 fRC := 0;
726 fFileStream := pSt;
727 fFileName := pFileName;
728 fFiles := TObjectList.Create(true);
729 end;
731 procedure TSFSVolume.removeCommonPath ();
732 begin
733 end;
735 procedure TSFSVolume.DoDirectoryRead ();
736 var
737 fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so!
738 f, c, n: Integer;
739 sfi: TSFSFileInfo;
740 tmp, fn, ext: TSFSString;
741 begin
742 fl := nil;
743 fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
744 try
745 ReadDirectory();
746 fFiles.Pack();
748 // check for duplicate file names
749 fl := TStringList.Create(); fl.Sorted := true;
750 for f := 0 to fFiles.Count-1 do
751 begin
752 sfi := TSFSFileInfo(fFiles[f]);
754 // normalize name & path
755 sfi.fPath := SFSReplacePathDelims(sfi.fPath, '/');
756 if (sfi.fPath <> '') and (sfi.fPath[1] = '/') then Delete(sfi.fPath, 1, 1);
757 if (sfi.fPath <> '') and (sfi.fPath[Length(sfi.fPath)] <> '/') then sfi.fPath := sfi.fPath+'/';
758 tmp := SFSReplacePathDelims(sfi.fName, '/');
759 c := Length(tmp); while (c > 0) and (tmp[c] <> '/') do Dec(c);
760 if c > 0 then
761 begin
762 // split path and name
763 Delete(sfi.fName, 1, c); // cut name
764 tmp := Copy(tmp, 1, c); // get path
765 if tmp = '/' then tmp := ''; // just delimiter; ignore it
766 sfi.fPath := sfi.fPath+tmp;
767 end;
769 // check for duplicates
770 if fl.Find(sfi.fPath+sfi.fName, c) then
771 begin
772 n := 0; tmp := sfi.fName;
773 c := Length(tmp); while (c > 0) and (tmp[c] <> '.') do Dec(c);
774 if c < 1 then c := Length(tmp)+1;
775 fn := Copy(tmp, 1, c-1); ext := Copy(tmp, c, Length(tmp));
776 repeat
777 tmp := fn+'_'+IntToStr(n)+ext;
778 if not fl.Find(sfi.fPath+tmp, c) then break;
779 Inc(n);
780 until false;
781 sfi.fName := tmp;
782 end;
783 fl.Add(sfi.fName);
784 end;
785 fl.Free();
786 except
787 fl.Free();
788 raise;
789 end;
790 removeCommonPath();
791 end;
793 destructor TSFSVolume.Destroy ();
794 begin
795 Clear();
796 FreeAndNil(fFiles);
797 inherited Destroy();
798 end;
800 procedure TSFSVolume.Clear ();
801 begin
802 fRC := 0; //FIXME
803 fFiles.Clear();
804 end;
806 function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer;
807 begin
808 if fFiles = nil then result := -1
809 else
810 begin
811 result := fFiles.Count;
812 while result > 0 do
813 begin
814 Dec(result);
815 if fFiles[result] <> nil then
816 begin
817 if SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and
818 SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) then exit;
819 end;
820 end;
821 result := -1;
822 end;
823 end;
825 function TSFSVolume.GetFileCount (): Integer;
826 begin
827 if fFiles = nil then result := 0 else result := fFiles.Count;
828 end;
830 function TSFSVolume.GetFiles (index: Integer): TSFSFileInfo;
831 begin
832 if fFiles = nil then result := nil
833 else
834 begin
835 if (index < 0) or (index >= fFiles.Count) then result := nil
836 else result := TSFSFileInfo(fFiles[index]);
837 end;
838 end;
840 function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream;
841 var
842 fp, fn: TSFSString;
843 f, ls: Integer;
844 begin
845 fp := fName;
846 // normalize name, find split position
847 if (fp <> '') and ((fp[1] = '/') or (fp[1] = '\')) then Delete(fp, 1, 1);
848 ls := 0;
849 for f := 1 to Length(fp) do
850 begin
851 if fp[f] = '\' then fp[f] := '/';
852 if fp[f] = '/' then ls := f;
853 end;
854 fn := Copy(fp, ls+1, Length(fp));
855 fp := Copy(fp, 1, ls);
856 f := FindFile(fp, fn);
857 if f = -1 then raise ESFSError.Create('file not found: "'+fName+'"');
858 result := OpenFileByIndex(f);
859 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
860 end;
863 { TSFSFileList }
864 constructor TSFSFileList.Create (const pVolume: TSFSVolume);
865 var
866 f: Integer;
867 begin
868 inherited Create();
869 ASSERT(pVolume <> nil);
870 f := FindVolumeInfoByVolumeInstance(pVolume);
871 ASSERT(f <> -1);
872 fVolume := pVolume;
873 Inc(TVolumeInfo(volumes[f]).fOpenedFilesCount); // íå ïîçâîëèì óáèòü çàïèñü!
874 end;
876 destructor TSFSFileList.Destroy ();
877 var
878 f: Integer;
879 begin
880 f := FindVolumeInfoByVolumeInstance(fVolume);
881 ASSERT(f <> -1);
882 if fVolume <> nil then Dec(fVolume.fRC);
883 Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
884 // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
885 if not TVolumeInfo(volumes[f]).fPermanent and
886 (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then volumes[f] := nil;
887 inherited Destroy();
888 end;
890 function TSFSFileList.GetCount (): Integer;
891 begin
892 result := fVolume.fFiles.Count;
893 end;
895 function TSFSFileList.GetFiles (index: Integer): TSFSFileInfo;
896 begin
897 if (index < 0) or (index >= fVolume.fFiles.Count) then result := nil
898 else result := TSFSFileInfo(fVolume.fFiles[index]);
899 end;
902 procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
903 var
904 f: Integer;
905 begin
906 if factory = nil then exit;
907 if factories.IndexOf(factory) <> -1 then
908 raise ESFSError.Create('duplicate factories are not allowed');
909 f := factories.IndexOf(nil);
910 if f = -1 then factories.Add(factory) else factories[f] := factory;
911 end;
913 procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
914 var
915 f: Integer;
916 c: Integer;
917 begin
918 if factory = nil then exit;
919 f := factories.IndexOf(factory);
920 if f = -1 then raise ESFSError.Create('can''t unregister nonexisting factory');
921 c := 0; while c < volumes.Count do
922 begin
923 if (volumes[c] <> nil) and (TVolumeInfo(volumes[c]).fFactory = factory) then volumes[c] := nil;
924 Inc(c);
925 end;
926 factories[f] := nil;
927 end;
930 function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream; top, permanent: Integer): Integer;
931 // dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
932 // ìîæåò âûêèíóòü èñêëþ÷åíèå!
933 // top:
934 // <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
935 // =0: íå ìåíÿòü.
936 // >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà.
937 // permanent:
938 // <0: ñîçäàòü "âðåìåííûé" òîì.
939 // =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà.
940 // >0: ñîçäàòü "ïîñòîÿííûé" òîì.
941 // åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì
942 // dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã.
943 // âîçâðàùàåò èíäåêñ â volumes.
944 // óìååò äåëàòü ðåêóðñèþ.
945 var
946 fac: TSFSVolumeFactory;
947 vol: TSFSVolume;
948 vi: TVolumeInfo;
949 f: Integer;
950 st, st1: TStream;
951 pfx: TSFSString;
952 fn, vfn, tmp: TSFSString;
953 begin
954 f := Pos('::', dataFileName);
955 if f <> 0 then
956 begin
957 // ðåêóðñèâíîå îòêðûòèå.
958 // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê.
959 // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì.
960 pfx := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f+1);
961 // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê...
962 result := SFSAddDataFileEx(pfx, ds, 0, 0);
963 // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì.
964 // óçíàåì, êàêîå ôàéëî îòêðûâàòü.
965 // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà).
966 f := Pos('::', dataFileName); if f = 0 then f := Length(dataFileName)+1;
967 fn := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f-1);
968 // dataFileName õðàíèò îñòàòîê.
969 // èçâëå÷¸ì èìÿ ôàéëà:
970 SplitDataName(fn, pfx, tmp, vfn);
971 // îòêðîåì ýòîò ôàéë
972 vi := TVolumeInfo(volumes[result]); st := nil;
973 try
974 st := vi.fVolume.OpenFileEx(tmp);
975 st1 := TOwnedPartialStream.Create(vi, st, 0, st.Size, true);
976 except
977 FreeAndNil(st);
978 // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì.
979 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil;
980 raise;
981 end;
982 // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå.
983 fn := fn+dataFileName;
984 try
985 st1.Position := 0;
986 result := SFSAddDataFileEx(fn, st1, top, permanent);
987 except
988 st1.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè.
989 raise;
990 end;
991 exit;
992 end;
994 // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå.
995 SplitDataName(dataFileName, pfx, fn, vfn);
997 f := FindVolumeInfo(vfn);
998 if f <> -1 then
999 begin
1000 if ds <> nil then raise ESFSError.Create('subdata name conflict');
1001 if permanent <> 0 then TVolumeInfo(volumes[f]).fPermanent := (permanent > 0);
1002 if top = 0 then result := f
1003 else if top < 0 then result := 0
1004 else result := volumes.Count-1;
1005 if result <> f then volumes.Move(f, result);
1006 exit;
1007 end;
1009 if ds <> nil then st := ds
1010 else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
1011 st.Position := 0;
1013 volumes.Pack();
1015 fac := nil; vol := nil;
1016 try
1017 for f := 0 to factories.Count-1 do
1018 begin
1019 fac := TSFSVolumeFactory(factories[f]);
1020 if fac = nil then continue;
1021 if (pfx <> '') and not fac.IsMyVolumePrefix(pfx) then continue;
1022 st.Position := 0;
1023 try
1024 if ds <> nil then vol := fac.Produce(pfx, '', st)
1025 else vol := fac.Produce(pfx, fn, st);
1026 except
1027 vol := nil;
1028 end;
1029 if vol <> nil then break;
1030 end;
1031 if vol = nil then raise ESFSError.Create('no factory for "'+dataFileName+'"');
1032 except
1033 if st <> ds then st.Free();
1034 raise;
1035 end;
1037 vi := TVolumeInfo.Create();
1038 try
1039 if top < 0 then
1040 begin
1041 result := 0;
1042 volumes.Insert(0, vi);
1043 end
1044 else result := volumes.Add(vi);
1045 except
1046 vol.Free();
1047 if st <> ds then st.Free();
1048 vi.Free();
1049 raise;
1050 end;
1052 vi.fFactory := fac;
1053 vi.fVolume := vol;
1054 vi.fPackName := vfn;
1055 vi.fStream := st;
1056 vi.fPermanent := (permanent > 0);
1057 vi.fNoDiskFile := (ds <> nil);
1058 vi.fOpenedFilesCount := 0;
1059 end;
1061 function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream;
1062 top: Boolean = false): Boolean;
1063 var
1064 tv: Integer;
1065 begin
1066 ASSERT(ds <> nil);
1067 try
1068 if top then tv := -1 else tv := 1;
1069 SFSAddDataFileEx(virtualName, ds, tv, 0);
1070 result := true;
1071 except
1072 result := false;
1073 end;
1074 end;
1076 function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean = false): Boolean;
1077 var
1078 tv: Integer;
1079 begin
1080 try
1081 if top then tv := -1 else tv := 1;
1082 SFSAddDataFileEx(dataFileName, nil, tv, 1);
1083 result := true;
1084 except
1085 result := false;
1086 end;
1087 end;
1090 function SFSExpandDirName (const s: TSFSString): TSFSString;
1091 var
1092 f, e: Integer;
1093 es: TSFSString;
1094 begin
1095 f := 1; result := s;
1096 while f < Length(result) do
1097 begin
1098 while (f < Length(result)) and (result[f] <> '<') do Inc(f);
1099 if f >= Length(result) then exit;
1100 e := f; while (e < Length(result)) and (result[e] <> '>') do Inc(e);
1101 es := Copy(result, f, e+1-f);
1103 if es = '<currentdir>' then es := GetCurrentDir
1104 else if es = '<exedir>' then es := ExtractFilePath(ParamStr(0))
1105 else es := '';
1107 if es <> '' then
1108 begin
1109 if (es[Length(es)] <> '/') and (es[Length(es)] <> '\') then es := es+'/';
1110 Delete(result, f, e+1-f);
1111 Insert(es, result, f);
1112 Inc(f, Length(es));
1113 end
1114 else f := e+1;
1115 end;
1116 end;
1118 function SFSFileOpenEx (const fName: TSFSString): TStream;
1119 var
1120 dataFileName, fn: TSFSString;
1121 f: Integer;
1122 vi: TVolumeInfo;
1123 diskChecked: Boolean;
1124 ps: TStream;
1126 function CheckDisk (): TStream;
1127 // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
1128 var
1129 dfn, dirs, cdir: TSFSString;
1130 f: Integer;
1131 begin
1132 result := nil;
1133 if diskChecked or not sfsDiskEnabled then exit;
1134 diskChecked := true;
1135 dfn := SFSReplacePathDelims(fn, '/');
1136 dirs := sfsDiskDirs; if dirs = '' then dirs := '<currentdir>';
1137 while dirs <> '' do
1138 begin
1139 f := 1; while (f <= Length(dirs)) and (dirs[f] <> '|') do Inc(f);
1140 cdir := Copy(dirs, 1, f-1); Delete(dirs, 1, f);
1141 if cdir = '' then continue;
1142 cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/');
1143 if cdir[Length(cdir)] <> '/' then cdir := cdir+'/';
1144 try
1145 result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite);
1146 exit;
1147 except
1148 end;
1149 end;
1150 end;
1152 begin
1153 SplitFName(fName, dataFileName, fn);
1154 if fn = '' then raise ESFSError.Create('invalid file name: "'+fName+'"');
1156 diskChecked := false;
1158 if dataFileName <> '' then
1159 begin
1160 // ïðåôèêñîâàíûé ôàéë
1161 if sfsForceDiskForPrefixed then
1162 begin
1163 result := CheckDisk();
1164 if result <> nil then exit;
1165 end;
1167 f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1168 vi := TVolumeInfo(volumes[f]);
1170 try
1171 result := vi.fVolume.OpenFileEx(fn);
1172 ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1173 except
1174 result.Free();
1175 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1176 result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê
1177 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1178 exit;
1179 end;
1180 //Inc(vi.fOpenedFilesCount);
1181 result := ps;
1182 exit;
1183 end;
1185 // íåïðåôèêñîâàíûé ôàéë
1186 if sfsDiskFirst then
1187 begin
1188 result := CheckDisk();
1189 if result <> nil then exit;
1190 end;
1191 // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì
1192 f := 0;
1193 while f < volumes.Count do
1194 begin
1195 vi := TVolumeInfo(volumes[f]);
1196 if (vi <> nil) and vi.fPermanent then
1197 begin
1198 if vi.fVolume <> nil then
1199 begin
1200 result := vi.fVolume.OpenFileEx(fn);
1201 if result <> nil then
1202 begin
1203 try
1204 ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1205 result := ps;
1206 //Inc(vi.fOpenedFilesCount);
1207 except
1208 FreeAndNil(result);
1209 end;
1210 end;
1211 if result <> nil then exit;
1212 end;
1213 end;
1214 Inc(f);
1215 end;
1216 result := CheckDisk();
1217 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1218 end;
1220 function SFSFileOpen (const fName: TSFSString): TStream;
1221 begin
1222 try
1223 result := SFSFileOpenEx(fName);
1224 except
1225 result := nil;
1226 end;
1227 end;
1229 function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
1230 var
1231 f: Integer;
1232 vi: TVolumeInfo;
1233 begin
1234 result := nil;
1235 if dataFileName = '' then exit;
1237 try
1238 f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1239 except
1240 exit;
1241 end;
1242 vi := TVolumeInfo(volumes[f]);
1244 try
1245 result := TSFSFileList.Create(vi.fVolume);
1246 Inc(vi.fVolume.fRC);
1247 except
1248 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1249 end;
1250 end;
1253 initialization
1254 factories := TObjectList.Create(true);
1255 volumes := TObjectList.Create(true);
1256 finalization
1257 //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?!
1258 //factories.Free(); // not need to be done actually...
1259 end.