DEADSOFTWARE

sfs: using locale-insensitive comparisons
[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 public
77 // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
78 constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
79 // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
80 destructor Destroy (); override;
82 // âûçûâàåò ReadDirectory().
83 // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â
84 // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð.
85 // òàêæå îíà íîðìàëèçóåò âèä èì¸í.
86 procedure DoDirectoryRead ();
88 // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè.
89 function OpenFileByIndex (const index: Integer): TStream; virtual; abstract;
91 // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
92 function OpenFileEx (const fName: TSFSString): TStream; virtual;
94 property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü
95 // ìîæåò âîçâðàùàòü NIL.
96 // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
97 property Files [index: Integer]: TSFSFileInfo read GetFiles;
98 end;
100 // ôàáðèêà òîìîâ. âñå SFS ïðè ñòàðòå äîáàâëÿþò ñâîè ôàáðèêè.
101 // áëàãîäàðÿ ýòîìó ìîæíî ñîçäàâàòü ðàçíûå âñÿêèå SFS ñòàíäàðòíûì
102 // âûçîâîì ñòàíäàðòíîé ïðîöåäóðû.
103 // ôàáðèêà ÍÅ ÄÎËÆÍÀ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè âûçîâà
104 // SFSUnregisterVolumeFactory()! ýòî ãàðàíòèðóåò, ÷òî äâèæîê
105 // ïåðåä ðàññòðåëîì îòäàñò åé âñå å¸ òîìà.
106 TSFSVolumeFactory = class
107 public
108 // åñëè äîáàâëÿåì ôàéë äàííûõ ôàéë ñ èìåíåì òèïà "zip:....", òî
109 // SFS èçâëå÷¸ò ýòî "zip" è ïåðåäàñò â ñèþ ôóíêöèþ.
110 // åæåëè ôóíêöèÿ âåðí¸ò ïðàâäó, òî SFS âûçîâåò Produce äëÿ äàííîãî
111 // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò.
112 // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà.
113 // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ!
114 function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract;
115 // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà.
116 // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå.
117 // ýòîò ïîòîê íåëüçÿ çàêðûâàòü!
118 // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''.
119 // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé.
120 function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract;
121 // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó.
122 // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì.
123 procedure Recycle (vol: TSFSVolume); virtual; abstract;
124 end;
126 // "èòåðàòîð", âîçâðàùàåìûé SFSFileList()
127 TSFSFileList = class
128 protected
129 fVolume: TSFSVolume;
131 function GetCount (): Integer;
132 function GetFiles (index: Integer): TSFSFileInfo;
134 public
135 constructor Create (const pVolume: TSFSVolume);
136 destructor Destroy (); override;
138 property Volume: TSFSVolume read fVolume;
139 property Count: Integer read GetCount;
140 // ïðè íåïðàâèëüíîì èíäåêñå ìîë÷à âåðí¸ò NIL.
141 // ïðè ïðàâèëüíîì òîæå ìîæåò âåðíóòü NIL!
142 // î÷åíü íå ñîâåòóþ ìåíÿòü ñîäåðæèìîå ïîëó÷åííîãî êëàññà.
143 // êîíå÷íî, ÿ ìîã áû âîçâðàùàòü íîâóþ ñòðóêòóðó èëè íå÷òî ïîõîæåå,
144 // íî áëèí, åñëè òû èäèîò è íå óìååøü äàæå êîììåíòû ÷èòàòü, òî
145 // êàêîãî òû âîîáùå â ïðîãðàììèíã ïîëåç?
146 property Files [index: Integer]: TSFSFileInfo read GetFiles; default;
147 end;
150 procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
151 // ýòà ôóíêöèÿ àâòîìàòè÷åñêè ïðèáü¸ò factory.
152 procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
154 // äîáàâèòü ñáîðíèê â ïîñòîÿííûé ñïèñîê.
155 // åñëè ñáîðíèê ñ òàêèì èìåíåì óæå îòêðûò, òî íå îòêðûâàåò åãî ïîâòîðíî.
156 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
157 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
158 // âåðí¸ò ëîæü ïðè îøèáêå.
159 // ñïîñîáíî îòêðûâàòü ñáîðíèêè â ñáîðíèêàõ ïðè ïîìîùè êðóòûõ èì¸í a-la:
160 // "zip:pack0::pack:pack1::wad2:pack2".
161 // â äàëüíåéøåì ñëåäóåò îáðàùàòüñÿ ê ñáîðíèêó êàê "pack2::xxx".
162 // èëè ìîæíî íàïèñàòü:
163 // "zip:pack0::pack:pack1::wad2:pack2|datafile".
164 // è îáðàùàòüñÿ êàê "datafile::xxx".
165 // "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ.
166 // ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà.
167 function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean;
169 // äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds.
170 // åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà
171 // óãðîáèò ñåé ïîòîê ïî íåîáõîäèìîñòè.
172 // virtualName ñòàíîâèòñÿ èìåíåì ñáîðíèêà äëÿ îïåðàöèè îòêðûòèÿ ôàéëà òèïà
173 // "packfile:file.ext".
174 // åñëè êàêîé-íèáóäü ñáîðíèê ñ èìåíåì virtualName óæå îòêðûò, âåðí¸ò false.
175 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
176 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
177 // âåðí¸ò ëîæü ïðè îøèáêå.
178 // îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ.
179 // ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå.
180 function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean;
182 // øâûðÿåòñÿ èñêëþ÷åíèÿìè.
183 // åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò
184 // îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì
185 // ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè.
186 // åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå.
187 function SFSFileOpenEx (const fName: TSFSString): TStream;
189 // ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé.
190 function SFSFileOpen (const fName: TSFSString): TStream;
192 // âîçâðàùàåò NIL ïðè îøèáêå.
193 // ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-)
194 function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
196 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
197 // èãíîðèðóåò ðåãèñòð ñèìâîëîâ
198 function SFSStrEqu (const s0, s1: TSFSString): Boolean;
200 // ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
201 // èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
202 function SFSGetLastVirtualName (const fn: TSFSString): string;
204 // ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè
205 function Int64ToStrComma (i: Int64): string;
207 // Wildcard matching
208 // this code is meant to allow wildcard pattern matches. tt is VERY useful
209 // for matching filename wildcard patterns. tt allows unix grep-like pattern
210 // comparisons, for instance:
211 //
212 // ? Matches any single characer
213 // + Matches any single characer or nothing
214 // * Matches any number of contiguous characters
215 // [abc] Matches a or b or c at that position
216 // [!abc] Matches anything but a or b or c at that position
217 // [a-e] Matches a through e at that position
218 //
219 // 'ma?ch.*' -Would match match.exe, mavch.dat, march.on, etc
220 // 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
221 // not match 'this as a yest'
222 //
223 function WildMatch (pattern, text: TSFSString): Boolean;
224 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
225 function HasWildcards (const pattern: TSFSString): Boolean;
228 var
229 // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
230 sfsDiskEnabled: Boolean = true;
231 // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå,
232 // ïîòîì â ôàéëàõ äàííûõ.
233 sfsDiskFirst: Boolean = true;
234 // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê
235 // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled).
236 sfsForceDiskForPrefixed: Boolean = false;
237 // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â
238 // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
239 // <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
240 // <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
241 sfsDiskDirs: TSFSString = '<currentdir>|<exedir>';
244 implementation
246 uses
247 xstreams;
250 function Int64ToStrComma (i: Int64): string;
251 var
252 f: Integer;
253 begin
254 Str(i, result);
255 f := Length(result)+1;
256 while f > 4 do
257 begin
258 Dec(f, 3); Insert(',', result, f);
259 end;
260 end;
263 const
264 // character defines
265 WILD_CHAR_ESCAPE = '\';
266 WILD_CHAR_SINGLE = '?';
267 WILD_CHAR_SINGLE_OR_NONE = '+';
268 WILD_CHAR_MULTI = '*';
269 WILD_CHAR_RANGE_OPEN = '[';
270 WILD_CHAR_RANGE = '-';
271 WILD_CHAR_RANGE_CLOSE = ']';
272 WILD_CHAR_RANGE_NOT = '!';
275 function HasWildcards (const pattern: TSFSString): Boolean;
276 begin
277 result :=
278 (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or
279 (Pos(WILD_CHAR_SINGLE, pattern) <> 0) or
280 (Pos(WILD_CHAR_SINGLE_OR_NONE, pattern) <> 0) or
281 (Pos(WILD_CHAR_MULTI, pattern) <> 0) or
282 (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0);
283 end;
285 function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean;
286 var
287 rangeStart, rangeEnd: AnsiChar;
288 rangeNot, rangeMatched: Boolean;
289 ch: AnsiChar;
290 begin
291 // sanity checks
292 if (pend < 0) or (pend > Length(pattern)) then pend := Length(pattern);
293 if (tend < 0) or (tend > Length(text)) then tend := Length(text);
294 if t < 1 then t := 1;
295 if p < 1 then p := 1;
296 while p <= pend do
297 begin
298 if t > tend then
299 begin
300 // no more text. check if there's no more chars in pattern (except "*" & "+")
301 while (p <= pend) and
302 ((pattern[p] = WILD_CHAR_MULTI) or
303 (pattern[p] = WILD_CHAR_SINGLE_OR_NONE)) do Inc(p);
304 result := (p > pend);
305 exit;
306 end;
307 case pattern[p] of
308 WILD_CHAR_SINGLE: ;
309 WILD_CHAR_ESCAPE:
310 begin
311 Inc(p);
312 if p > pend then result := false else result := (pattern[p] = text[t]);
313 if not result then exit;
314 end;
315 WILD_CHAR_RANGE_OPEN:
316 begin
317 result := false;
318 Inc(p); if p > pend then exit; // sanity check
319 rangeNot := (pattern[p] = WILD_CHAR_RANGE_NOT);
320 if rangeNot then begin Inc(p); if p > pend then exit; {sanity check} end;
321 if pattern[p] = WILD_CHAR_RANGE_CLOSE then exit; // sanity check
322 ch := text[t]; // speed reasons
323 rangeMatched := false;
324 repeat
325 if p > pend then exit; // sanity check
326 rangeStart := pattern[p];
327 if rangeStart = WILD_CHAR_RANGE_CLOSE then break;
328 Inc(p); if p > pend then exit; // sanity check
329 if pattern[p] = WILD_CHAR_RANGE then
330 begin
331 Inc(p); if p > pend then exit; // sanity check
332 rangeEnd := pattern[p]; Inc(p);
333 if rangeStart < rangeEnd then
334 begin
335 rangeMatched := (ch >= rangeStart) and (ch <= rangeEnd);
336 end
337 else rangeMatched := (ch >= rangeEnd) and (ch <= rangeStart);
338 end
339 else rangeMatched := (ch = rangeStart);
340 until rangeMatched;
341 if rangeNot = rangeMatched then exit;
343 // skip the rest or the range
344 while (p <= pend) and (pattern[p] <> WILD_CHAR_RANGE_CLOSE) do Inc(p);
345 if p > pend then exit; // sanity check
346 end;
347 WILD_CHAR_SINGLE_OR_NONE:
348 begin
349 Inc(p);
350 result := MatchMask(pattern, p, pend, text, t, tend);
351 if not result then result := MatchMask(pattern, p, pend, text, t+1, tend);
352 exit;
353 end;
354 WILD_CHAR_MULTI:
355 begin
356 while (p <= pend) and (pattern[p] = WILD_CHAR_MULTI) do Inc(p);
357 result := (p > pend); if result then exit;
358 while not result and (t <= tend) do
359 begin
360 result := MatchMask(pattern, p, pend, text, t, tend);
361 Inc(t);
362 end;
363 exit;
364 end;
365 else result := (pattern[p] = text[t]); if not result then exit;
366 end;
367 Inc(p); Inc(t);
368 end;
369 result := (t > tend);
370 end;
373 function WildMatch (pattern, text: TSFSString): Boolean;
374 begin
375 if pattern <> '' then pattern := AnsiLowerCase(pattern);
376 if text <> '' then text := AnsiLowerCase(text);
377 result := MatchMask(pattern, 1, -1, text, 1, -1);
378 end;
380 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
381 var
382 s, e: Integer;
383 begin
384 if wildList <> '' then wildList := AnsiLowerCase(wildList);
385 if text <> '' then text := AnsiLowerCase(text);
386 result := 0;
387 s := 1;
388 while s <= Length(wildList) do
389 begin
390 e := s; while e <= Length(wildList) do
391 begin
392 if wildList[e] = WILD_CHAR_RANGE_OPEN then
393 begin
394 while (e <= Length(wildList)) and (wildList[e] <> WILD_CHAR_RANGE_CLOSE) do Inc(e);
395 end;
396 if wildList[e] = delimChar then break;
397 Inc(e);
398 end;
399 if s < e then
400 begin
401 if MatchMask(wildList, s, e-1, text, 1, -1) then exit;
402 end;
403 Inc(result);
404 s := e+1;
405 end;
406 result := -1;
407 end;
410 type
411 TVolumeInfo = class
412 fFactory: TSFSVolumeFactory;
413 fVolume: TSFSVolume;
414 fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
415 fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
416 fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
417 // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
418 fNoDiskFile: Boolean;
419 fOpenedFilesCount: Integer;
421 destructor Destroy (); override;
422 end;
424 TOwnedPartialStream = class (TSFSPartialStream)
425 protected
426 fOwner: TVolumeInfo;
428 public
429 constructor Create (pOwner: TVolumeInfo; pSrc: TStream; pPos, pSize: Int64; pKillSrc: Boolean);
430 destructor Destroy (); override;
431 end;
434 var
435 factories: TObjectList; // TSFSVolumeFactory
436 volumes: TObjectList; // TVolumeInfo
439 // ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
440 // ñîáñòâåííî èìÿ ôàéëà
441 // èìÿ âûãëÿäèò êàê:
442 // (("sfspfx:")?"datafile::")*"filename"
443 procedure SplitFName (const fn: string; out dataFile, fileName: string);
444 var
445 f: Integer;
446 begin
447 f := Length(fn)-1;
448 while f >= 1 do
449 begin
450 if (fn[f] = ':') and (fn[f+1] = ':') then break;
451 Dec(f);
452 end;
453 if f < 1 then begin dataFile := ''; fileName := fn; end
454 else
455 begin
456 dataFile := Copy(fn, 1, f-1);
457 fileName := Copy(fn, f+2, maxInt-10000);
458 end;
459 end;
461 // ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
462 function ExtractVirtName (var dataFile: string): string;
463 var
464 f: Integer;
465 begin
466 f := Length(dataFile); result := dataFile;
467 while f > 1 do
468 begin
469 if dataFile[f] = ':' then break;
470 if dataFile[f] = '|' then
471 begin
472 if dataFile[f-1] = '|' then begin Dec(f); Delete(dataFile, f, 1); end
473 else
474 begin
475 result := Copy(dataFile, f+1, Length(dataFile));
476 Delete(dataFile, f, Length(dataFile));
477 break;
478 end;
479 end;
480 Dec(f);
481 end;
482 end;
484 // ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
485 // âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile.
486 // èìÿ âûãëÿäèò êàê:
487 // [sfspfx:]datafile[|virtname]
488 // åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
489 // à èìåíåì äèñêà.
490 procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string);
491 var
492 f: Integer;
493 begin
494 f := Pos(':', fn);
495 if f <= 3 then begin pfx := ''; dataFile := fn; end
496 else
497 begin
498 pfx := Copy(fn, 1, f-1);
499 dataFile := Copy(fn, f+1, maxInt-10000);
500 end;
501 virtName := ExtractVirtName(dataFile);
502 end;
504 // íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
505 // onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
506 function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer;
507 var
508 f: Integer;
509 vi: TVolumeInfo;
510 begin
511 f := 0;
512 while f < volumes.Count do
513 begin
514 if volumes[f] <> nil then
515 begin
516 vi := TVolumeInfo(volumes[f]);
517 if not onlyPerm or vi.fPermanent then
518 begin
519 if SFSStrEqu(vi.fPackName, dataFileName) then
520 begin
521 result := f;
522 exit;
523 end;
524 end;
525 end;
526 Inc(f);
527 end;
528 result := -1;
529 end;
531 // íàéòè èíôó äëÿ ýòîãî òîìà.
532 // õîðîøåå èìÿ, ïðàâäà? %-)
533 function FindVolumeInfoByVolumeInstance (vol: TSFSVolume): Integer;
534 begin
535 result := volumes.Count-1;
536 while result >= 0 do
537 begin
538 if volumes[result] <> nil then
539 begin
540 if TVolumeInfo(volumes[result]).fVolume = vol then exit;
541 end;
542 Dec(result);
543 end;
544 end;
546 function le2upper (ch: Char): Char;
547 begin
548 if ch < #128 then
549 begin
550 if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32);
551 end
552 else
553 begin
554 if (ch >= #224) and (ch <= #255) then
555 begin
556 Dec(ch, 32);
557 end
558 else
559 begin
560 case ch of
561 #184, #186, #191: Dec(ch, 16);
562 #162, #179: Dec(ch);
563 end;
564 end;
565 end;
566 result := ch;
567 end;
569 function SFSStrEqu (const s0, s1: TSFSString): Boolean;
570 var
571 i: Integer;
572 begin
573 //result := (AnsiCompareText(s0, s1) == 0);
574 result := false;
575 if length(s0) <> length(s1) then exit;
576 for i := 1 to length(s0) do
577 begin
578 if le2upper(s0[i]) <> le2upper(s1[i]) then exit;
579 end;
580 result := true;
581 end;
583 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
584 var
585 f: Integer;
586 begin
587 result := s;
588 for f := 1 to Length(result) do
589 begin
590 if (result[f] = '/') or (result[f] = '\') then
591 begin
592 // avoid unnecessary string changes
593 if result[f] <> newDelim then result[f] := newDelim;
594 end;
595 end;
596 end;
598 function SFSGetLastVirtualName (const fn: TSFSString): string;
599 var
600 rest, tmp: string;
601 f: Integer;
602 begin
603 rest := fn;
604 repeat
605 f := Pos('::', rest); if f = 0 then f := Length(rest)+1;
606 tmp := Copy(rest, 1, f-1); Delete(rest, 1, f+1);
607 result := ExtractVirtName(tmp);
608 until rest = '';
609 end;
612 { TVolumeInfo }
613 destructor TVolumeInfo.Destroy ();
614 var
615 f, me: Integer;
616 used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
617 begin
618 if fFactory <> nil then fFactory.Recycle(fVolume);
619 if fVolume <> nil then used := (fVolume.fRC <> 0) else used := false;
620 fVolume := nil;
621 fFactory := nil;
622 fPackName := '';
624 // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ, òî óãðîáèòü åãî íàôèã
625 if not used then
626 begin
627 me := volumes.IndexOf(self);
628 f := volumes.Count-1;
629 while not used and (f >= 0) do
630 begin
631 if (f <> me) and (volumes[f] <> nil) then
632 begin
633 used := (TVolumeInfo(volumes[f]).fStream = fStream);
634 if not used then
635 begin
636 used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream);
637 end;
638 if used then break;
639 end;
640 Dec(f);
641 end;
642 end;
643 if not used then FreeAndNil(fStream); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì
644 inherited Destroy();
645 end;
648 { TOwnedPartialStream }
649 constructor TOwnedPartialStream.Create (pOwner: TVolumeInfo; pSrc: TStream;
650 pPos, pSize: Int64; pKillSrc: Boolean);
651 begin
652 inherited Create(pSrc, pPos, pSize, pKillSrc);
653 fOwner := pOwner;
654 if pOwner <> nil then Inc(pOwner.fOpenedFilesCount);
655 end;
657 destructor TOwnedPartialStream.Destroy ();
658 var
659 f: Integer;
660 begin
661 inherited Destroy();
662 if fOwner <> nil then
663 begin
664 Dec(fOwner.fOpenedFilesCount);
665 if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then
666 begin
667 f := volumes.IndexOf(fOwner);
668 if f <> -1 then volumes[f] := nil; // this will destroy the volume
669 end;
670 end;
671 end;
674 { TSFSFileInfo }
675 constructor TSFSFileInfo.Create (pOwner: TSFSVolume);
676 begin
677 inherited Create();
678 fOwner := pOwner;
679 fPath := '';
680 fName := '';
681 fSize := 0;
682 fOfs := 0;
683 if pOwner <> nil then pOwner.fFiles.Add(self);
684 end;
686 destructor TSFSFileInfo.Destroy ();
687 begin
688 if fOwner <> nil then fOwner.fFiles.Extract(self);
689 inherited Destroy();
690 end;
693 { TSFSVolume }
694 constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream);
695 begin
696 inherited Create();
697 fRC := 0;
698 fFileStream := pSt;
699 fFileName := pFileName;
700 fFiles := TObjectList.Create(true);
701 end;
703 procedure TSFSVolume.DoDirectoryRead ();
704 var
705 fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so!
706 f, c, n: Integer;
707 sfi: TSFSFileInfo;
708 tmp, fn, ext: TSFSString;
709 begin
710 fl := nil;
711 fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/'));
712 try
713 ReadDirectory();
714 fFiles.Pack();
716 // check for duplicate file names
717 fl := TStringList.Create(); fl.Sorted := true;
718 for f := 0 to fFiles.Count-1 do
719 begin
720 sfi := TSFSFileInfo(fFiles[f]);
722 // normalize name & path
723 sfi.fPath := SFSReplacePathDelims(sfi.fPath, '/');
724 if (sfi.fPath <> '') and (sfi.fPath[1] = '/') then Delete(sfi.fPath, 1, 1);
725 if (sfi.fPath <> '') and (sfi.fPath[Length(sfi.fPath)] <> '/') then sfi.fPath := sfi.fPath+'/';
726 tmp := SFSReplacePathDelims(sfi.fName, '/');
727 c := Length(tmp); while (c > 0) and (tmp[c] <> '/') do Dec(c);
728 if c > 0 then
729 begin
730 // split path and name
731 Delete(sfi.fName, 1, c); // cut name
732 tmp := Copy(tmp, 1, c); // get path
733 if tmp = '/' then tmp := ''; // just delimiter; ignore it
734 sfi.fPath := sfi.fPath+tmp;
735 end;
737 // check for duplicates
738 if fl.Find(sfi.fPath+sfi.fName, c) then
739 begin
740 n := 0; tmp := sfi.fName;
741 c := Length(tmp); while (c > 0) and (tmp[c] <> '.') do Dec(c);
742 if c < 1 then c := Length(tmp)+1;
743 fn := Copy(tmp, 1, c-1); ext := Copy(tmp, c, Length(tmp));
744 repeat
745 tmp := fn+'_'+IntToStr(n)+ext;
746 if not fl.Find(sfi.fPath+tmp, c) then break;
747 Inc(n);
748 until false;
749 sfi.fName := tmp;
750 end;
751 fl.Add(sfi.fName);
752 end;
753 fl.Free();
754 except
755 fl.Free();
756 raise;
757 end;
758 end;
760 destructor TSFSVolume.Destroy ();
761 begin
762 Clear();
763 FreeAndNil(fFiles);
764 inherited Destroy();
765 end;
767 procedure TSFSVolume.Clear ();
768 begin
769 fRC := 0; //FIXME
770 fFiles.Clear();
771 end;
773 function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer;
774 begin
775 if fFiles = nil then result := -1
776 else
777 begin
778 result := fFiles.Count;
779 while result > 0 do
780 begin
781 Dec(result);
782 if fFiles[result] <> nil then
783 begin
784 if SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and
785 SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) then exit;
786 end;
787 end;
788 result := -1;
789 end;
790 end;
792 function TSFSVolume.GetFileCount (): Integer;
793 begin
794 if fFiles = nil then result := 0 else result := fFiles.Count;
795 end;
797 function TSFSVolume.GetFiles (index: Integer): TSFSFileInfo;
798 begin
799 if fFiles = nil then result := nil
800 else
801 begin
802 if (index < 0) or (index >= fFiles.Count) then result := nil
803 else result := TSFSFileInfo(fFiles[index]);
804 end;
805 end;
807 function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream;
808 var
809 fp, fn: TSFSString;
810 f, ls: Integer;
811 begin
812 fp := fName;
813 // normalize name, find split position
814 if (fp <> '') and ((fp[1] = '/') or (fp[1] = '\')) then Delete(fp, 1, 1);
815 ls := 0;
816 for f := 1 to Length(fp) do
817 begin
818 if fp[f] = '\' then fp[f] := '/';
819 if fp[f] = '/' then ls := f;
820 end;
821 fn := Copy(fp, ls+1, Length(fp));
822 fp := Copy(fp, 1, ls);
823 f := FindFile(fp, fn);
824 if f = -1 then raise ESFSError.Create('file not found: "'+fName+'"');
825 result := OpenFileByIndex(f);
826 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
827 end;
830 { TSFSFileList }
831 constructor TSFSFileList.Create (const pVolume: TSFSVolume);
832 var
833 f: Integer;
834 begin
835 inherited Create();
836 ASSERT(pVolume <> nil);
837 f := FindVolumeInfoByVolumeInstance(pVolume);
838 ASSERT(f <> -1);
839 fVolume := pVolume;
840 Inc(TVolumeInfo(volumes[f]).fOpenedFilesCount); // íå ïîçâîëèì óáèòü çàïèñü!
841 end;
843 destructor TSFSFileList.Destroy ();
844 var
845 f: Integer;
846 begin
847 f := FindVolumeInfoByVolumeInstance(fVolume);
848 ASSERT(f <> -1);
849 if fVolume <> nil then Dec(fVolume.fRC);
850 Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount);
851 // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
852 if not TVolumeInfo(volumes[f]).fPermanent and
853 (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then volumes[f] := nil;
854 inherited Destroy();
855 end;
857 function TSFSFileList.GetCount (): Integer;
858 begin
859 result := fVolume.fFiles.Count;
860 end;
862 function TSFSFileList.GetFiles (index: Integer): TSFSFileInfo;
863 begin
864 if (index < 0) or (index >= fVolume.fFiles.Count) then result := nil
865 else result := TSFSFileInfo(fVolume.fFiles[index]);
866 end;
869 procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory);
870 var
871 f: Integer;
872 begin
873 if factory = nil then exit;
874 if factories.IndexOf(factory) <> -1 then
875 raise ESFSError.Create('duplicate factories are not allowed');
876 f := factories.IndexOf(nil);
877 if f = -1 then factories.Add(factory) else factories[f] := factory;
878 end;
880 procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory);
881 var
882 f: Integer;
883 c: Integer;
884 begin
885 if factory = nil then exit;
886 f := factories.IndexOf(factory);
887 if f = -1 then raise ESFSError.Create('can''t unregister nonexisting factory');
888 c := 0; while c < volumes.Count do
889 begin
890 if (volumes[c] <> nil) and (TVolumeInfo(volumes[c]).fFactory = factory) then volumes[c] := nil;
891 Inc(c);
892 end;
893 factories[f] := nil;
894 end;
897 function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream; top, permanent: Integer): Integer;
898 // dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
899 // ìîæåò âûêèíóòü èñêëþ÷åíèå!
900 // top:
901 // <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
902 // =0: íå ìåíÿòü.
903 // >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà.
904 // permanent:
905 // <0: ñîçäàòü "âðåìåííûé" òîì.
906 // =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà.
907 // >0: ñîçäàòü "ïîñòîÿííûé" òîì.
908 // åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì
909 // dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã.
910 // âîçâðàùàåò èíäåêñ â volumes.
911 // óìååò äåëàòü ðåêóðñèþ.
912 var
913 fac: TSFSVolumeFactory;
914 vol: TSFSVolume;
915 vi: TVolumeInfo;
916 f: Integer;
917 st, st1: TStream;
918 pfx: TSFSString;
919 fn, vfn, tmp: TSFSString;
920 begin
921 f := Pos('::', dataFileName);
922 if f <> 0 then
923 begin
924 // ðåêóðñèâíîå îòêðûòèå.
925 // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê.
926 // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì.
927 pfx := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f+1);
928 // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê...
929 result := SFSAddDataFileEx(pfx, ds, 0, 0);
930 // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì.
931 // óçíàåì, êàêîå ôàéëî îòêðûâàòü.
932 // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà).
933 f := Pos('::', dataFileName); if f = 0 then f := Length(dataFileName)+1;
934 fn := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f-1);
935 // dataFileName õðàíèò îñòàòîê.
936 // èçâëå÷¸ì èìÿ ôàéëà:
937 SplitDataName(fn, pfx, tmp, vfn);
938 // îòêðîåì ýòîò ôàéë
939 vi := TVolumeInfo(volumes[result]); st := nil;
940 try
941 st := vi.fVolume.OpenFileEx(tmp);
942 st1 := TOwnedPartialStream.Create(vi, st, 0, st.Size, true);
943 except
944 FreeAndNil(st);
945 // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì.
946 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil;
947 raise;
948 end;
949 // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå.
950 fn := fn+dataFileName;
951 try
952 st1.Position := 0;
953 result := SFSAddDataFileEx(fn, st1, top, permanent);
954 except
955 st1.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè.
956 raise;
957 end;
958 exit;
959 end;
961 // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå.
962 SplitDataName(dataFileName, pfx, fn, vfn);
964 f := FindVolumeInfo(vfn);
965 if f <> -1 then
966 begin
967 if ds <> nil then raise ESFSError.Create('subdata name conflict');
968 if permanent <> 0 then TVolumeInfo(volumes[f]).fPermanent := (permanent > 0);
969 if top = 0 then result := f
970 else if top < 0 then result := 0
971 else result := volumes.Count-1;
972 if result <> f then volumes.Move(f, result);
973 exit;
974 end;
976 if ds <> nil then st := ds
977 else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
978 st.Position := 0;
980 volumes.Pack();
982 fac := nil; vol := nil;
983 try
984 for f := 0 to factories.Count-1 do
985 begin
986 fac := TSFSVolumeFactory(factories[f]);
987 if fac = nil then continue;
988 if (pfx <> '') and not fac.IsMyVolumePrefix(pfx) then continue;
989 st.Position := 0;
990 try
991 if ds <> nil then vol := fac.Produce(pfx, '', st)
992 else vol := fac.Produce(pfx, fn, st);
993 except
994 vol := nil;
995 end;
996 if vol <> nil then break;
997 end;
998 if vol = nil then raise ESFSError.Create('no factory for "'+dataFileName+'"');
999 except
1000 if st <> ds then st.Free();
1001 raise;
1002 end;
1004 vi := TVolumeInfo.Create();
1005 try
1006 if top < 0 then
1007 begin
1008 result := 0;
1009 volumes.Insert(0, vi);
1010 end
1011 else result := volumes.Add(vi);
1012 except
1013 vol.Free();
1014 if st <> ds then st.Free();
1015 vi.Free();
1016 raise;
1017 end;
1019 vi.fFactory := fac;
1020 vi.fVolume := vol;
1021 vi.fPackName := vfn;
1022 vi.fStream := st;
1023 vi.fPermanent := (permanent > 0);
1024 vi.fNoDiskFile := (ds <> nil);
1025 vi.fOpenedFilesCount := 0;
1026 end;
1028 function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream;
1029 top: Boolean = false): Boolean;
1030 var
1031 tv: Integer;
1032 begin
1033 ASSERT(ds <> nil);
1034 try
1035 if top then tv := -1 else tv := 1;
1036 SFSAddDataFileEx(virtualName, ds, tv, 0);
1037 result := true;
1038 except
1039 result := false;
1040 end;
1041 end;
1043 function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean = false): Boolean;
1044 var
1045 tv: Integer;
1046 begin
1047 try
1048 if top then tv := -1 else tv := 1;
1049 SFSAddDataFileEx(dataFileName, nil, tv, 1);
1050 result := true;
1051 except
1052 result := false;
1053 end;
1054 end;
1057 function SFSExpandDirName (const s: TSFSString): TSFSString;
1058 var
1059 f, e: Integer;
1060 es: TSFSString;
1061 begin
1062 f := 1; result := s;
1063 while f < Length(result) do
1064 begin
1065 while (f < Length(result)) and (result[f] <> '<') do Inc(f);
1066 if f >= Length(result) then exit;
1067 e := f; while (e < Length(result)) and (result[e] <> '>') do Inc(e);
1068 es := Copy(result, f, e+1-f);
1070 if es = '<currentdir>' then es := GetCurrentDir
1071 else if es = '<exedir>' then es := ExtractFilePath(ParamStr(0))
1072 else es := '';
1074 if es <> '' then
1075 begin
1076 if (es[Length(es)] <> '/') and (es[Length(es)] <> '\') then es := es+'/';
1077 Delete(result, f, e+1-f);
1078 Insert(es, result, f);
1079 Inc(f, Length(es));
1080 end
1081 else f := e+1;
1082 end;
1083 end;
1085 function SFSFileOpenEx (const fName: TSFSString): TStream;
1086 var
1087 dataFileName, fn: TSFSString;
1088 f: Integer;
1089 vi: TVolumeInfo;
1090 diskChecked: Boolean;
1091 ps: TStream;
1093 function CheckDisk (): TStream;
1094 // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
1095 var
1096 dfn, dirs, cdir: TSFSString;
1097 f: Integer;
1098 begin
1099 result := nil;
1100 if diskChecked or not sfsDiskEnabled then exit;
1101 diskChecked := true;
1102 dfn := SFSReplacePathDelims(fn, '/');
1103 dirs := sfsDiskDirs; if dirs = '' then dirs := '<currentdir>';
1104 while dirs <> '' do
1105 begin
1106 f := 1; while (f <= Length(dirs)) and (dirs[f] <> '|') do Inc(f);
1107 cdir := Copy(dirs, 1, f-1); Delete(dirs, 1, f);
1108 if cdir = '' then continue;
1109 cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/');
1110 if cdir[Length(cdir)] <> '/' then cdir := cdir+'/';
1111 try
1112 result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite);
1113 exit;
1114 except
1115 end;
1116 end;
1117 end;
1119 begin
1120 SplitFName(fName, dataFileName, fn);
1121 if fn = '' then raise ESFSError.Create('invalid file name: "'+fName+'"');
1123 diskChecked := false;
1125 if dataFileName <> '' then
1126 begin
1127 // ïðåôèêñîâàíûé ôàéë
1128 if sfsForceDiskForPrefixed then
1129 begin
1130 result := CheckDisk();
1131 if result <> nil then exit;
1132 end;
1134 f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1135 vi := TVolumeInfo(volumes[f]);
1137 try
1138 result := vi.fVolume.OpenFileEx(fn);
1139 ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1140 except
1141 result.Free();
1142 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1143 result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê
1144 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1145 exit;
1146 end;
1147 //Inc(vi.fOpenedFilesCount);
1148 result := ps;
1149 exit;
1150 end;
1152 // íåïðåôèêñîâàíûé ôàéë
1153 if sfsDiskFirst then
1154 begin
1155 result := CheckDisk();
1156 if result <> nil then exit;
1157 end;
1158 // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì
1159 f := 0;
1160 while f < volumes.Count do
1161 begin
1162 vi := TVolumeInfo(volumes[f]);
1163 if (vi <> nil) and vi.fPermanent then
1164 begin
1165 if vi.fVolume <> nil then
1166 begin
1167 result := vi.fVolume.OpenFileEx(fn);
1168 if result <> nil then
1169 begin
1170 try
1171 ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true);
1172 result := ps;
1173 //Inc(vi.fOpenedFilesCount);
1174 except
1175 FreeAndNil(result);
1176 end;
1177 end;
1178 if result <> nil then exit;
1179 end;
1180 end;
1181 Inc(f);
1182 end;
1183 result := CheckDisk();
1184 if result = nil then raise ESFSError.Create('file not found: "'+fName+'"');
1185 end;
1187 function SFSFileOpen (const fName: TSFSString): TStream;
1188 begin
1189 try
1190 result := SFSFileOpenEx(fName);
1191 except
1192 result := nil;
1193 end;
1194 end;
1196 function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
1197 var
1198 f: Integer;
1199 vi: TVolumeInfo;
1200 begin
1201 result := nil;
1202 if dataFileName = '' then exit;
1204 try
1205 f := SFSAddDataFileEx(dataFileName, nil, 0, 0);
1206 except
1207 exit;
1208 end;
1209 vi := TVolumeInfo(volumes[f]);
1211 try
1212 result := TSFSFileList.Create(vi.fVolume);
1213 Inc(vi.fVolume.fRC);
1214 except
1215 if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil;
1216 end;
1217 end;
1220 initialization
1221 factories := TObjectList.Create(true);
1222 volumes := TObjectList.Create(true);
1223 finalization
1224 //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?!
1225 //factories.Free(); // not need to be done actually...
1226 end.