1 // streaming file system (virtual)
9 SysUtils
, Classes
, Contnrs
;
13 ESFSError
= class(Exception
);
16 TSFSString
= AnsiString;
22 fOwner
: TSFSVolume
; // òàê, íà âñÿêèé ñëó÷àé
23 fPath
: TSFSString
; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/"
24 fName
: TSFSString
; // òîëüêî èìÿ
25 fSize
: Int64; // unpacked
26 fOfs
: Int64; // in VFS (many of 'em need this %-)
28 constructor Create (pOwner
: TSFSVolume
);
29 destructor Destroy (); override;
31 property path
: TSFSString read fPath
;
32 property name
: TSFSString read fName
;
33 property size
: Int64 read fSize
;
36 // âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß!
37 // òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè!
40 fRC
: Integer; // refcounter for other objects
41 fFileName
: TSFSString
;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà
42 fFileStream
: TStream
; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà
43 fFiles
: TObjectList
; // TSFSFileInfo èëè íàñëåäíèêè
45 // ïðèøèáèòü âñå ñòðóêòóðû.
46 // íå äîëæíà ïàäàòü, åñëè å¸ âûçûâàþò íåñêîëüêî ðàç.
47 procedure Clear (); virtual;
49 // âûçûâàåòñÿ èç DoDirectoryRead() äëÿ çàïîëíåíèÿ ñïèñêà ôàéëîâ.
50 // ñ÷èòàåòñÿ, ÷òî âñå ìàãèêè óæå ïðîâåðåíû è ôàéë òî÷íî íàø.
51 // fFileName, fFileStream óæå óñòàíîâëåíû, fFiles ñîçäàí,
52 // â í¸ì, ñêîðåå âñåãî, íèêîãî íåò.
53 // ïîçèöèÿ ïîòîêà -- òà, ÷òî îñòàâèëà ôàáðèêà.
54 // ïðè îøèáêàõ êèäàòü èñêëþ÷åíèå, òîãäà òîì áóäåò ïðèáèò ôàáðèêîé.
55 // ðàçäåëèòåëè ïóòåé äîëæíû áûòü òîëüêî "/", êîðíåâîé "/" äîëæåí
56 // áûòü îïóùåí, ïóòè (åñëè íå ïóñòûå) äîëæíû çàâåðøàòüñÿ "/"!
57 // fName äîëæíî ñîäåðæàòü òîëüêî èìÿ, fPath -- òîëüêî ïóòü.
58 // â ïðèíöèïå, îá ýòîì ïîçàáîòèòñÿ DoDirectoryRead(), íî çà÷åì
59 // äàâàòü åìó ëèøíþþ ðàáîòó?
60 procedure ReadDirectory (); virtual; abstract;
62 // íàéòè ôàéë, âåðíóòü åãî èíäåêñ â fFiles.
63 // ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles!
64 // fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí.
65 // åñëè ôàéë íå íàéäåí, âåðíóòü -1.
66 function FindFile (const fPath
, fName
: TSFSString
): Integer; virtual;
68 // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles
69 function GetFileCount (): Integer; virtual;
71 // âîçâðàùàåò ôàéë ñ èíäåêñîì index.
72 // ìîæåò âîçâðàùàòü NIL.
73 // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
74 function GetFiles (index
: Integer): TSFSFileInfo
; virtual;
76 procedure removeCommonPath (); virtual;
79 // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
80 constructor Create (const pFileName
: TSFSString
; pSt
: TStream
); virtual;
81 // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà.
82 destructor Destroy (); override;
84 // âûçûâàåò ReadDirectory().
85 // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â
86 // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð.
87 // òàêæå îíà íîðìàëèçóåò âèä èì¸í.
88 procedure DoDirectoryRead ();
90 // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè.
91 function OpenFileByIndex (const index
: Integer): TStream
; virtual; abstract;
93 // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå.
94 function OpenFileEx (const fName
: TSFSString
): TStream
; virtual;
96 property FileCount
: Integer read GetFileCount
; // ìîæåò âåðíóòü íîëü
97 // ìîæåò âîçâðàùàòü NIL.
98 // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
99 property Files
[index
: Integer]: TSFSFileInfo read GetFiles
;
102 // ôàáðèêà òîìîâ. âñå SFS ïðè ñòàðòå äîáàâëÿþò ñâîè ôàáðèêè.
103 // áëàãîäàðÿ ýòîìó ìîæíî ñîçäàâàòü ðàçíûå âñÿêèå SFS ñòàíäàðòíûì
104 // âûçîâîì ñòàíäàðòíîé ïðîöåäóðû.
105 // ôàáðèêà ÍÅ ÄÎËÆÍÀ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè âûçîâà
106 // SFSUnregisterVolumeFactory()! ýòî ãàðàíòèðóåò, ÷òî äâèæîê
107 // ïåðåä ðàññòðåëîì îòäàñò åé âñå å¸ òîìà.
108 TSFSVolumeFactory
= class
110 // åñëè äîáàâëÿåì ôàéë äàííûõ ôàéë ñ èìåíåì òèïà "zip:....", òî
111 // SFS èçâëå÷¸ò ýòî "zip" è ïåðåäàñò â ñèþ ôóíêöèþ.
112 // åæåëè ôóíêöèÿ âåðí¸ò ïðàâäó, òî SFS âûçîâåò Produce äëÿ äàííîãî
113 // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò.
114 // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà.
115 // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ!
116 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; virtual; abstract;
117 // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà.
118 // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå.
119 // ýòîò ïîòîê íåëüçÿ çàêðûâàòü!
120 // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''.
121 // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé.
122 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; virtual; abstract;
123 // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó.
124 // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì.
125 procedure Recycle (vol
: TSFSVolume
); virtual; abstract;
128 // "èòåðàòîð", âîçâðàùàåìûé SFSFileList()
133 function GetCount (): Integer;
134 function GetFiles (index
: Integer): TSFSFileInfo
;
137 constructor Create (const pVolume
: TSFSVolume
);
138 destructor Destroy (); override;
140 property Volume
: TSFSVolume read fVolume
;
141 property Count
: Integer read GetCount
;
142 // ïðè íåïðàâèëüíîì èíäåêñå ìîë÷à âåðí¸ò NIL.
143 // ïðè ïðàâèëüíîì òîæå ìîæåò âåðíóòü NIL!
144 // î÷åíü íå ñîâåòóþ ìåíÿòü ñîäåðæèìîå ïîëó÷åííîãî êëàññà.
145 // êîíå÷íî, ÿ ìîã áû âîçâðàùàòü íîâóþ ñòðóêòóðó èëè íå÷òî ïîõîæåå,
146 // íî áëèí, åñëè òû èäèîò è íå óìååøü äàæå êîììåíòû ÷èòàòü, òî
147 // êàêîãî òû âîîáùå â ïðîãðàììèíã ïîëåç?
148 property Files
[index
: Integer]: TSFSFileInfo read GetFiles
; default
;
152 procedure SFSRegisterVolumeFactory (factory
: TSFSVolumeFactory
);
153 // ýòà ôóíêöèÿ àâòîìàòè÷åñêè ïðèáü¸ò factory.
154 procedure SFSUnregisterVolumeFactory (factory
: TSFSVolumeFactory
);
156 // äîáàâèòü ñáîðíèê â ïîñòîÿííûé ñïèñîê.
157 // åñëè ñáîðíèê ñ òàêèì èìåíåì óæå îòêðûò, òî íå îòêðûâàåò åãî ïîâòîðíî.
158 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
159 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
160 // âåðí¸ò ëîæü ïðè îøèáêå.
161 // ñïîñîáíî îòêðûâàòü ñáîðíèêè â ñáîðíèêàõ ïðè ïîìîùè êðóòûõ èì¸í a-la:
162 // "zip:pack0::pack:pack1::wad2:pack2".
163 // â äàëüíåéøåì ñëåäóåò îáðàùàòüñÿ ê ñáîðíèêó êàê "pack2::xxx".
164 // èëè ìîæíî íàïèñàòü:
165 // "zip:pack0::pack:pack1::wad2:pack2|datafile".
166 // è îáðàùàòüñÿ êàê "datafile::xxx".
167 // "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ.
168 // ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà.
169 function SFSAddDataFile (const dataFileName
: TSFSString
; top
: Boolean=false): Boolean;
171 // äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds.
172 // åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà
173 // óãðîáèò ñåé ïîòîê ïî íåîáõîäèìîñòè.
174 // virtualName ñòàíîâèòñÿ èìåíåì ñáîðíèêà äëÿ îïåðàöèè îòêðûòèÿ ôàéëà òèïà
175 // "packfile:file.ext".
176 // åñëè êàêîé-íèáóäü ñáîðíèê ñ èìåíåì virtualName óæå îòêðûò, âåðí¸ò false.
177 // íèêîãäà íå êèäàåò èñêëþ÷åíèé.
178 // top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
179 // âåðí¸ò ëîæü ïðè îøèáêå.
180 // îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ.
181 // ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå.
182 function SFSAddSubDataFile (const virtualName
: TSFSString
; ds
: TStream
; top
: Boolean=false): Boolean;
184 // øâûðÿåòñÿ èñêëþ÷åíèÿìè.
185 // åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò
186 // îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì
187 // ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè.
188 // åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå.
189 function SFSFileOpenEx (const fName
: TSFSString
): TStream
;
191 // ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé.
192 function SFSFileOpen (const fName
: TSFSString
): TStream
;
194 // âîçâðàùàåò NIL ïðè îøèáêå.
195 // ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-)
196 function SFSFileList (const dataFileName
: TSFSString
): TSFSFileList
;
198 function SFSReplacePathDelims (const s
: TSFSString
; newDelim
: TSFSChar
): TSFSString
;
199 // èãíîðèðóåò ðåãèñòð ñèìâîëîâ
200 function SFSStrEqu (const s0
, s1
: TSFSString
): Boolean;
202 // ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
203 // èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
204 function SFSGetLastVirtualName (const fn
: TSFSString
): string;
206 // ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè
207 function Int64ToStrComma (i
: Int64): string;
210 // this code is meant to allow wildcard pattern matches. tt is VERY useful
211 // for matching filename wildcard patterns. tt allows unix grep-like pattern
212 // comparisons, for instance:
214 // ? Matches any single characer
215 // + Matches any single characer or nothing
216 // * Matches any number of contiguous characters
217 // [abc] Matches a or b or c at that position
218 // [!abc] Matches anything but a or b or c at that position
219 // [a-e] Matches a through e at that position
221 // 'ma?ch.*' -Would match match.exe, mavch.dat, march.on, etc
222 // 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would
223 // not match 'this as a yest'
225 function WildMatch (pattern
, text: TSFSString
): Boolean;
226 function WildListMatch (wildList
, text: TSFSString
; delimChar
: AnsiChar=':'): Integer;
227 function HasWildcards (const pattern
: TSFSString
): Boolean;
229 // this will compare only last path element from sfspath
230 function SFSDFPathEqu (sfspath
: string; path
: string): Boolean;
232 function SFSUpCase (ch
: Char): Char;
236 // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
237 sfsDiskEnabled
: Boolean = true;
238 // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå,
239 // ïîòîì â ôàéëàõ äàííûõ.
240 sfsDiskFirst
: Boolean = true;
241 // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê
242 // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled).
243 sfsForceDiskForPrefixed
: Boolean = false;
244 // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â
245 // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|").
246 // <currentdir> çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"),
247 // <exedir> çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/").
248 sfsDiskDirs
: TSFSString
= '<currentdir>|<exedir>';
257 function Int64ToStrComma (i
: Int64): string;
262 f
:= Length(result
)+1;
265 Dec(f
, 3); Insert(',', result
, f
);
272 WILD_CHAR_ESCAPE
= '\';
273 WILD_CHAR_SINGLE
= '?';
274 WILD_CHAR_SINGLE_OR_NONE
= '+';
275 WILD_CHAR_MULTI
= '*';
276 WILD_CHAR_RANGE_OPEN
= '[';
277 WILD_CHAR_RANGE
= '-';
278 WILD_CHAR_RANGE_CLOSE
= ']';
279 WILD_CHAR_RANGE_NOT
= '!';
282 function HasWildcards (const pattern
: TSFSString
): Boolean;
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);
292 function MatchMask (const pattern
: TSFSString
; p
, pend
: Integer; const text: TSFSString
; t
, tend
: Integer): Boolean;
294 rangeStart
, rangeEnd
: AnsiChar;
295 rangeNot
, rangeMatched
: Boolean;
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;
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
);
319 if p
> pend
then result
:= false else result
:= (pattern
[p
] = text[t
]);
320 if not result
then exit
;
322 WILD_CHAR_RANGE_OPEN
:
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;
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
338 Inc(p
); if p
> pend
then exit
; // sanity check
339 rangeEnd
:= pattern
[p
]; Inc(p
);
340 if rangeStart
< rangeEnd
then
342 rangeMatched
:= (ch
>= rangeStart
) and (ch
<= rangeEnd
);
344 else rangeMatched
:= (ch
>= rangeEnd
) and (ch
<= rangeStart
);
346 else rangeMatched
:= (ch
= rangeStart
);
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
354 WILD_CHAR_SINGLE_OR_NONE
:
357 result
:= MatchMask(pattern
, p
, pend
, text, t
, tend
);
358 if not result
then result
:= MatchMask(pattern
, p
, pend
, text, t
+1, tend
);
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
367 result
:= MatchMask(pattern
, p
, pend
, text, t
, tend
);
372 else result
:= (pattern
[p
] = text[t
]); if not result
then exit
;
376 result
:= (t
> tend
);
380 function WildMatch (pattern
, text: TSFSString
): Boolean;
382 if pattern
<> '' then pattern
:= AnsiLowerCase(pattern
);
383 if text <> '' then text := AnsiLowerCase(text);
384 result
:= MatchMask(pattern
, 1, -1, text, 1, -1);
387 function WildListMatch (wildList
, text: TSFSString
; delimChar
: AnsiChar=':'): Integer;
391 if wildList
<> '' then wildList
:= AnsiLowerCase(wildList
);
392 if text <> '' then text := AnsiLowerCase(text);
395 while s
<= Length(wildList
) do
397 e
:= s
; while e
<= Length(wildList
) do
399 if wildList
[e
] = WILD_CHAR_RANGE_OPEN
then
401 while (e
<= Length(wildList
)) and (wildList
[e
] <> WILD_CHAR_RANGE_CLOSE
) do Inc(e
);
403 if wildList
[e
] = delimChar
then break
;
408 if MatchMask(wildList
, s
, e
-1, text, 1, -1) then exit
;
419 fFactory
: TSFSVolumeFactory
;
421 fPackName
: TSFSString
; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì!
422 fStream
: TStream
; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà
423 fPermanent
: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà
424 // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà
425 fNoDiskFile
: Boolean;
426 fOpenedFilesCount
: Integer;
428 destructor Destroy (); override;
431 TOwnedPartialStream
= class (TSFSPartialStream
)
436 constructor Create (pOwner
: TVolumeInfo
; pSrc
: TStream
; pPos
, pSize
: Int64; pKillSrc
: Boolean);
437 destructor Destroy (); override;
442 factories
: TObjectList
; // TSFSVolumeFactory
443 volumes
: TObjectList
; // TVolumeInfo
446 // ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
447 // ñîáñòâåííî èìÿ ôàéëà
449 // (("sfspfx:")?"datafile::")*"filename"
450 procedure SplitFName (const fn
: string; out dataFile
, fileName
: string);
457 if (fn
[f
] = ':') and (fn
[f
+1] = ':') then break
;
460 if f
< 1 then begin dataFile
:= ''; fileName
:= fn
; end
463 dataFile
:= Copy(fn
, 1, f
-1);
464 fileName
:= Copy(fn
, f
+2, maxInt
-10000);
468 // ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile.
469 function ExtractVirtName (var dataFile
: string): string;
473 f
:= Length(dataFile
); result
:= dataFile
;
476 if dataFile
[f
] = ':' then break
;
477 if dataFile
[f
] = '|' then
479 if dataFile
[f
-1] = '|' then begin Dec(f
); Delete(dataFile
, f
, 1); end
482 result
:= Copy(dataFile
, f
+1, Length(dataFile
));
483 Delete(dataFile
, f
, Length(dataFile
));
491 // ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ,
492 // âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile.
494 // [sfspfx:]datafile[|virtname]
495 // åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì,
497 procedure SplitDataName (const fn
: string; out pfx
, dataFile
, virtName
: string);
502 if f
<= 3 then begin pfx
:= ''; dataFile
:= fn
; end
505 pfx
:= Copy(fn
, 1, f
-1);
506 dataFile
:= Copy(fn
, f
+1, maxInt
-10000);
508 virtName
:= ExtractVirtName(dataFile
);
511 // íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò).
512 // onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè.
513 function FindVolumeInfo (const dataFileName
: TSFSString
; onlyPerm
: Boolean=false): Integer;
519 while f
< volumes
.Count
do
521 if volumes
[f
] <> nil then
523 vi
:= TVolumeInfo(volumes
[f
]);
524 if not onlyPerm
or vi
.fPermanent
then
526 if SFSStrEqu(vi
.fPackName
, dataFileName
) then
538 // íàéòè èíôó äëÿ ýòîãî òîìà.
539 // õîðîøåå èìÿ, ïðàâäà? %-)
540 function FindVolumeInfoByVolumeInstance (vol
: TSFSVolume
): Integer;
542 result
:= volumes
.Count
-1;
545 if volumes
[result
] <> nil then
547 if TVolumeInfo(volumes
[result
]).fVolume
= vol
then exit
;
553 function SFSUpCase (ch
: Char): Char;
557 if (ch
>= 'a') and (ch
<= 'z') then Dec(ch
, 32);
561 if (ch
>= #224) and (ch
<= #255) then
568 #184, #186, #191: Dec(ch
, 16);
576 function SFSStrEqu (const s0
, s1
: TSFSString
): Boolean;
580 //result := (AnsiCompareText(s0, s1) == 0);
582 if length(s0
) <> length(s1
) then exit
;
583 for i
:= 1 to length(s0
) do
585 if SFSUpCase(s0
[i
]) <> SFSUpCase(s1
[i
]) then exit
;
590 // this will compare only last path element from sfspath
591 function SFSDFPathEqu (sfspath
: string; path
: string): Boolean;
595 result
:= SFSStrEqu(sfspath
, path
);
597 if not result and (length(sfspath) > 1) then
599 i := length(sfspath);
602 while (i > 1) and (sfspath[i-1] <> '/') do Dec(i);
604 writeln('{', sfspath, '} [', Copy(sfspath, i, length(sfspath)), '] : [', path, ']');
605 result := SFSStrEqu(Copy(sfspath, i, length(sfspath)), path);
612 function normalizePath (fn
: string): string;
618 while i
<= length(fn
) do
620 if (fn
[i
] = '.') and ((length(fn
)-i
= 0) or (fn
[i
+1] = '/') or (fn
[i
+1] = '\')) then
625 if (fn
[i
] = '/') or (fn
[i
] = '\') then
627 if (length(result
) > 0) and (result
[length(result
)] <> '/') then result
:= result
+'/';
631 result
:= result
+fn
[i
];
635 if (length(result
) > 0) and (result
[length(result
)] <> '/') then result
:= result
+'/';
638 function SFSReplacePathDelims (const s
: TSFSString
; newDelim
: TSFSChar
): TSFSString
;
643 for f
:= 1 to Length(result
) do
645 if (result
[f
] = '/') or (result
[f
] = '\') then
647 // avoid unnecessary string changes
648 if result
[f
] <> newDelim
then result
[f
] := newDelim
;
653 function SFSGetLastVirtualName (const fn
: TSFSString
): string;
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
);
668 destructor TVolumeInfo
.Destroy ();
671 used
: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸
673 if fFactory
<> nil then fFactory
.Recycle(fVolume
);
674 if fVolume
<> nil then used
:= (fVolume
.fRC
<> 0) else used
:= false;
679 // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ, òî óãðîáèòü åãî íàôèã
682 me
:= volumes
.IndexOf(self
);
683 f
:= volumes
.Count
-1;
684 while not used
and (f
>= 0) do
686 if (f
<> me
) and (volumes
[f
] <> nil) then
688 used
:= (TVolumeInfo(volumes
[f
]).fStream
= fStream
);
691 used
:= (TVolumeInfo(volumes
[f
]).fVolume
.fFileStream
= fStream
);
698 if not used
then FreeAndNil(fStream
); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì
703 { TOwnedPartialStream }
704 constructor TOwnedPartialStream
.Create (pOwner
: TVolumeInfo
; pSrc
: TStream
;
705 pPos
, pSize
: Int64; pKillSrc
: Boolean);
707 inherited Create(pSrc
, pPos
, pSize
, pKillSrc
);
709 if pOwner
<> nil then Inc(pOwner
.fOpenedFilesCount
);
712 destructor TOwnedPartialStream
.Destroy ();
717 if fOwner
<> nil then
719 Dec(fOwner
.fOpenedFilesCount
);
720 if not fOwner
.fPermanent
and (fOwner
.fOpenedFilesCount
< 1) then
722 f
:= volumes
.IndexOf(fOwner
);
723 if f
<> -1 then volumes
[f
] := nil; // this will destroy the volume
730 constructor TSFSFileInfo
.Create (pOwner
: TSFSVolume
);
738 if pOwner
<> nil then pOwner
.fFiles
.Add(self
);
741 destructor TSFSFileInfo
.Destroy ();
743 if fOwner
<> nil then fOwner
.fFiles
.Extract(self
);
749 constructor TSFSVolume
.Create (const pFileName
: TSFSString
; pSt
: TStream
);
754 fFileName
:= pFileName
;
755 fFiles
:= TObjectList
.Create(true);
758 procedure TSFSVolume
.removeCommonPath ();
762 procedure TSFSVolume
.DoDirectoryRead ();
768 fFileName
:= ExpandFileName(SFSReplacePathDelims(fFileName
, '/'));
772 for f
:= 0 to fFiles
.Count
-1 do
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
);
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
;
789 sfi
.fPath
:= normalizePath(sfi
.fPath
);
794 destructor TSFSVolume
.Destroy ();
801 procedure TSFSVolume
.Clear ();
807 function TSFSVolume
.FindFile (const fPath
, fName
: TSFSString
): Integer;
809 if fFiles
= nil then result
:= -1
812 result
:= fFiles
.Count
;
816 if fFiles
[result
] <> nil then
818 if SFSStrEqu(fPath
, TSFSFileInfo(fFiles
[result
]).fPath
) and
819 SFSStrEqu(fName
, TSFSFileInfo(fFiles
[result
]).fName
) then exit
;
826 function TSFSVolume
.GetFileCount (): Integer;
828 if fFiles
= nil then result
:= 0 else result
:= fFiles
.Count
;
831 function TSFSVolume
.GetFiles (index
: Integer): TSFSFileInfo
;
833 if fFiles
= nil then result
:= nil
836 if (index
< 0) or (index
>= fFiles
.Count
) then result
:= nil
837 else result
:= TSFSFileInfo(fFiles
[index
]);
841 function TSFSVolume
.OpenFileEx (const fName
: TSFSString
): TStream
;
847 // normalize name, find split position
848 if (fp
<> '') and ((fp
[1] = '/') or (fp
[1] = '\')) then Delete(fp
, 1, 1);
850 for f
:= 1 to Length(fp
) do
852 if fp
[f
] = '\' then fp
[f
] := '/';
853 if fp
[f
] = '/' then ls
:= f
;
855 fn
:= Copy(fp
, ls
+1, Length(fp
));
856 fp
:= Copy(fp
, 1, ls
);
857 f
:= FindFile(fp
, fn
);
858 if f
= -1 then raise ESFSError
.Create('file not found: "'+fName
+'"');
859 result
:= OpenFileByIndex(f
);
860 if result
= nil then raise ESFSError
.Create('file not found: "'+fName
+'"');
865 constructor TSFSFileList
.Create (const pVolume
: TSFSVolume
);
870 ASSERT(pVolume
<> nil);
871 f
:= FindVolumeInfoByVolumeInstance(pVolume
);
874 Inc(TVolumeInfo(volumes
[f
]).fOpenedFilesCount
); // íå ïîçâîëèì óáèòü çàïèñü!
877 destructor TSFSFileList
.Destroy ();
881 f
:= FindVolumeInfoByVolumeInstance(fVolume
);
883 if fVolume
<> nil then Dec(fVolume
.fRC
);
884 Dec(TVolumeInfo(volumes
[f
]).fOpenedFilesCount
);
885 // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî
886 if not TVolumeInfo(volumes
[f
]).fPermanent
and
887 (TVolumeInfo(volumes
[f
]).fOpenedFilesCount
< 1) then volumes
[f
] := nil;
891 function TSFSFileList
.GetCount (): Integer;
893 result
:= fVolume
.fFiles
.Count
;
896 function TSFSFileList
.GetFiles (index
: Integer): TSFSFileInfo
;
898 if (index
< 0) or (index
>= fVolume
.fFiles
.Count
) then result
:= nil
899 else result
:= TSFSFileInfo(fVolume
.fFiles
[index
]);
903 procedure SFSRegisterVolumeFactory (factory
: TSFSVolumeFactory
);
907 if factory
= nil then exit
;
908 if factories
.IndexOf(factory
) <> -1 then
909 raise ESFSError
.Create('duplicate factories are not allowed');
910 f
:= factories
.IndexOf(nil);
911 if f
= -1 then factories
.Add(factory
) else factories
[f
] := factory
;
914 procedure SFSUnregisterVolumeFactory (factory
: TSFSVolumeFactory
);
919 if factory
= nil then exit
;
920 f
:= factories
.IndexOf(factory
);
921 if f
= -1 then raise ESFSError
.Create('can''t unregister nonexisting factory');
922 c
:= 0; while c
< volumes
.Count
do
924 if (volumes
[c
] <> nil) and (TVolumeInfo(volumes
[c
]).fFactory
= factory
) then volumes
[c
] := nil;
931 function SFSAddDataFileEx (dataFileName
: TSFSString
; ds
: TStream
; top
, permanent
: Integer): Integer;
932 // dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix).
933 // ìîæåò âûêèíóòü èñêëþ÷åíèå!
935 // <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà.
937 // >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà.
939 // <0: ñîçäàòü "âðåìåííûé" òîì.
940 // =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà.
941 // >0: ñîçäàòü "ïîñòîÿííûé" òîì.
942 // åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì
943 // dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã.
944 // âîçâðàùàåò èíäåêñ â volumes.
945 // óìååò äåëàòü ðåêóðñèþ.
947 fac
: TSFSVolumeFactory
;
953 fn
, vfn
, tmp
: TSFSString
;
955 f
:= Pos('::', dataFileName
);
958 // ðåêóðñèâíîå îòêðûòèå.
959 // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê.
960 // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì.
961 pfx
:= Copy(dataFileName
, 1, f
-1); Delete(dataFileName
, 1, f
+1);
962 // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê...
963 result
:= SFSAddDataFileEx(pfx
, ds
, 0, 0);
964 // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì.
965 // óçíàåì, êàêîå ôàéëî îòêðûâàòü.
966 // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà).
967 f
:= Pos('::', dataFileName
); if f
= 0 then f
:= Length(dataFileName
)+1;
968 fn
:= Copy(dataFileName
, 1, f
-1); Delete(dataFileName
, 1, f
-1);
969 // dataFileName õðàíèò îñòàòîê.
970 // èçâëå÷¸ì èìÿ ôàéëà:
971 SplitDataName(fn
, pfx
, tmp
, vfn
);
973 vi
:= TVolumeInfo(volumes
[result
]); st
:= nil;
975 st
:= vi
.fVolume
.OpenFileEx(tmp
);
976 st1
:= TOwnedPartialStream
.Create(vi
, st
, 0, st
.Size
, true);
979 // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì.
980 if not vi
.fPermanent
and (vi
.fOpenedFilesCount
< 1) then volumes
[result
] := nil;
983 // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå.
984 fn
:= fn
+dataFileName
;
987 result
:= SFSAddDataFileEx(fn
, st1
, top
, permanent
);
989 st1
.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè.
995 // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå.
996 SplitDataName(dataFileName
, pfx
, fn
, vfn
);
998 f
:= FindVolumeInfo(vfn
);
1001 if ds
<> nil then raise ESFSError
.Create('subdata name conflict');
1002 if permanent
<> 0 then TVolumeInfo(volumes
[f
]).fPermanent
:= (permanent
> 0);
1003 if top
= 0 then result
:= f
1004 else if top
< 0 then result
:= 0
1005 else result
:= volumes
.Count
-1;
1006 if result
<> f
then volumes
.Move(f
, result
);
1010 if ds
<> nil then st
:= ds
1011 else st
:= TFileStream
.Create(fn
, fmOpenRead
or fmShareDenyWrite
);
1016 fac
:= nil; vol
:= nil;
1018 for f
:= 0 to factories
.Count
-1 do
1020 fac
:= TSFSVolumeFactory(factories
[f
]);
1021 if fac
= nil then continue
;
1022 if (pfx
<> '') and not fac
.IsMyVolumePrefix(pfx
) then continue
;
1025 if ds
<> nil then vol
:= fac
.Produce(pfx
, '', st
)
1026 else vol
:= fac
.Produce(pfx
, fn
, st
);
1030 if vol
<> nil then break
;
1032 if vol
= nil then raise ESFSError
.Create('no factory for "'+dataFileName
+'"');
1034 if st
<> ds
then st
.Free();
1038 vi
:= TVolumeInfo
.Create();
1043 volumes
.Insert(0, vi
);
1045 else result
:= volumes
.Add(vi
);
1048 if st
<> ds
then st
.Free();
1055 vi
.fPackName
:= vfn
;
1057 vi
.fPermanent
:= (permanent
> 0);
1058 vi
.fNoDiskFile
:= (ds
<> nil);
1059 vi
.fOpenedFilesCount
:= 0;
1062 function SFSAddSubDataFile (const virtualName
: TSFSString
; ds
: TStream
;
1063 top
: Boolean = false): Boolean;
1069 if top
then tv
:= -1 else tv
:= 1;
1070 SFSAddDataFileEx(virtualName
, ds
, tv
, 0);
1077 function SFSAddDataFile (const dataFileName
: TSFSString
; top
: Boolean = false): Boolean;
1082 if top
then tv
:= -1 else tv
:= 1;
1083 SFSAddDataFileEx(dataFileName
, nil, tv
, 1);
1091 function SFSExpandDirName (const s
: TSFSString
): TSFSString
;
1096 f
:= 1; result
:= s
;
1097 while f
< Length(result
) do
1099 while (f
< Length(result
)) and (result
[f
] <> '<') do Inc(f
);
1100 if f
>= Length(result
) then exit
;
1101 e
:= f
; while (e
< Length(result
)) and (result
[e
] <> '>') do Inc(e
);
1102 es
:= Copy(result
, f
, e
+1-f
);
1104 if es
= '<currentdir>' then es
:= GetCurrentDir
1105 else if es
= '<exedir>' then es
:= ExtractFilePath(ParamStr(0))
1110 if (es
[Length(es
)] <> '/') and (es
[Length(es
)] <> '\') then es
:= es
+'/';
1111 Delete(result
, f
, e
+1-f
);
1112 Insert(es
, result
, f
);
1119 function SFSFileOpenEx (const fName
: TSFSString
): TStream
;
1121 dataFileName
, fn
: TSFSString
;
1124 diskChecked
: Boolean;
1127 function CheckDisk (): TStream
;
1128 // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ.
1130 dfn
, dirs
, cdir
: TSFSString
;
1134 if diskChecked
or not sfsDiskEnabled
then exit
;
1135 diskChecked
:= true;
1136 dfn
:= SFSReplacePathDelims(fn
, '/');
1137 dirs
:= sfsDiskDirs
; if dirs
= '' then dirs
:= '<currentdir>';
1140 f
:= 1; while (f
<= Length(dirs
)) and (dirs
[f
] <> '|') do Inc(f
);
1141 cdir
:= Copy(dirs
, 1, f
-1); Delete(dirs
, 1, f
);
1142 if cdir
= '' then continue
;
1143 cdir
:= SFSReplacePathDelims(SFSExpandDirName(cdir
), '/');
1144 if cdir
[Length(cdir
)] <> '/' then cdir
:= cdir
+'/';
1146 result
:= TFileStream
.Create(cdir
+dfn
, fmOpenRead
or fmShareDenyWrite
);
1154 SplitFName(fName
, dataFileName
, fn
);
1155 if fn
= '' then raise ESFSError
.Create('invalid file name: "'+fName
+'"');
1157 diskChecked
:= false;
1159 if dataFileName
<> '' then
1161 // ïðåôèêñîâàíûé ôàéë
1162 if sfsForceDiskForPrefixed
then
1164 result
:= CheckDisk();
1165 if result
<> nil then exit
;
1168 f
:= SFSAddDataFileEx(dataFileName
, nil, 0, 0);
1169 vi
:= TVolumeInfo(volumes
[f
]);
1172 result
:= vi
.fVolume
.OpenFileEx(fn
);
1173 ps
:= TOwnedPartialStream
.Create(vi
, result
, 0, result
.Size
, true);
1176 if not vi
.fPermanent
and (vi
.fOpenedFilesCount
< 1) then volumes
[f
] := nil;
1177 result
:= CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê
1178 if result
= nil then raise ESFSError
.Create('file not found: "'+fName
+'"');
1181 //Inc(vi.fOpenedFilesCount);
1186 // íåïðåôèêñîâàíûé ôàéë
1187 if sfsDiskFirst
then
1189 result
:= CheckDisk();
1190 if result
<> nil then exit
;
1192 // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì
1194 while f
< volumes
.Count
do
1196 vi
:= TVolumeInfo(volumes
[f
]);
1197 if (vi
<> nil) and vi
.fPermanent
then
1199 if vi
.fVolume
<> nil then
1201 result
:= vi
.fVolume
.OpenFileEx(fn
);
1202 if result
<> nil then
1205 ps
:= TOwnedPartialStream
.Create(vi
, result
, 0, result
.Size
, true);
1207 //Inc(vi.fOpenedFilesCount);
1212 if result
<> nil then exit
;
1217 result
:= CheckDisk();
1218 if result
= nil then raise ESFSError
.Create('file not found: "'+fName
+'"');
1221 function SFSFileOpen (const fName
: TSFSString
): TStream
;
1224 result
:= SFSFileOpenEx(fName
);
1230 function SFSFileList (const dataFileName
: TSFSString
): TSFSFileList
;
1236 if dataFileName
= '' then exit
;
1239 f
:= SFSAddDataFileEx(dataFileName
, nil, 0, 0);
1243 vi
:= TVolumeInfo(volumes
[f
]);
1246 result
:= TSFSFileList
.Create(vi
.fVolume
);
1247 Inc(vi
.fVolume
.fRC
);
1249 if not vi
.fPermanent
and (vi
.fOpenedFilesCount
< 1) then volumes
[f
] := nil;
1255 factories
:= TObjectList
.Create(true);
1256 volumes
:= TObjectList
.Create(true);
1258 //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?!
1259 //factories.Free(); // not need to be done actually...