DEADSOFTWARE

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