DEADSOFTWARE

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