DEADSOFTWARE

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