X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2Fsfs.pas;h=11e1045459cc1e894c28a9f35aa20f0e4bf6aafc;hb=1b91259cc2544a3e3dd76adb5e8f8ef0879fc199;hp=7588ae7fc7bfad89bb544866293272e1dffe887c;hpb=4d17c87d4865a7e2a7089a226238a144bb6c8de2;p=d2df-sdl.git diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas index 7588ae7..11e1045 100644 --- a/src/sfs/sfs.pas +++ b/src/sfs/sfs.pas @@ -1,6 +1,21 @@ +(* Copyright (C) Doom 2D: Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, version 3 of the License ONLY. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) // streaming file system (virtual) -{$MODE DELPHI} -{.$R-} +{$INCLUDE ../shared/a_modes.inc} +{$SCOPEDENUMS OFF} +{.$R+} {.$DEFINE SFS_VOLDEBUG} unit sfs; @@ -13,33 +28,29 @@ uses type ESFSError = class(Exception); - TSFSChar = AnsiChar; - TSFSString = AnsiString; - TSFSVolume = class; TSFSFileInfo = class public fOwner: TSFSVolume; // òàê, íà âñÿêèé ñëó÷àé - fPath: TSFSString; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/" - fName: TSFSString; // òîëüêî èìÿ + fPath: AnsiString; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàòüñÿ "/" + fName: AnsiString; // òîëüêî èìÿ fSize: Int64; // unpacked fOfs: Int64; // in VFS (many of 'em need this %-) constructor Create (pOwner: TSFSVolume); destructor Destroy (); override; - property path: TSFSString read fPath; - property name: TSFSString read fName; - property size: Int64 read fSize; + property path: AnsiString read fPath; + property name: AnsiString read fName; + property size: Int64 read fSize; // can be -1 if size is unknown end; // âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß! // òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè! TSFSVolume = class protected - fRC: Integer; // refcounter for other objects - fFileName: TSFSString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà + fFileName: AnsiString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà fFileStream: TStream; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà fFiles: TObjectList; // TSFSFileInfo èëè íàñëåäíèêè @@ -64,7 +75,7 @@ type // ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles! // fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí. // åñëè ôàéë íå íàéäåí, âåðíóòü -1. - function FindFile (const fPath, fName: TSFSString): Integer; virtual; + function FindFile (const fPath, fName: AnsiString): Integer; virtual; // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles function GetFileCount (): Integer; virtual; @@ -74,11 +85,9 @@ type // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû! function GetFiles (index: Integer): TSFSFileInfo; virtual; - procedure removeCommonPath (); virtual; - public // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí. - constructor Create (const pFileName: TSFSString; pSt: TStream); virtual; + constructor Create (const pFileName: AnsiString; pSt: TStream); virtual; // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà. destructor Destroy (); override; @@ -92,7 +101,7 @@ type function OpenFileByIndex (const index: Integer): TStream; virtual; abstract; // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå. - function OpenFileEx (const fName: TSFSString): TStream; virtual; + function OpenFileEx (const fName: AnsiString): TStream; virtual; property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü // ìîæåò âîçâðàùàòü NIL. @@ -114,13 +123,13 @@ type // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò. // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà. // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ! - function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract; + function IsMyVolumePrefix (const prefix: AnsiString): Boolean; virtual; abstract; // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà. // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå. // ýòîò ïîòîê íåëüçÿ çàêðûâàòü! // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''. // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé. - function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract; + function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; virtual; abstract; // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó. // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì. procedure Recycle (vol: TSFSVolume); virtual; abstract; @@ -167,10 +176,10 @@ procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory); // è îáðàùàòüñÿ êàê "datafile::xxx". // "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ. // ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà. -function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean; +function SFSAddDataFile (const dataFileName: AnsiString; top: Boolean=false): Boolean; // äîáàâèòü ñáîðíèê âðåìåííî -function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false): Boolean; +function SFSAddDataFileTemp (const dataFileName: AnsiString; top: Boolean=false): Boolean; // äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds. // åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà @@ -183,36 +192,36 @@ function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false) // âåðí¸ò ëîæü ïðè îøèáêå. // îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ. // ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå. -function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean; +function SFSAddSubDataFile (const virtualName: AnsiString; ds: TStream; top: Boolean=false): Boolean; // øâûðÿåòñÿ èñêëþ÷åíèÿìè. // åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò // îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì // ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè. // åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå. -function SFSFileOpenEx (const fName: TSFSString): TStream; +function SFSFileOpenEx (const fName: AnsiString): TStream; // ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé. -function SFSFileOpen (const fName: TSFSString): TStream; +function SFSFileOpen (const fName: AnsiString): TStream; // âîçâðàùàåò NIL ïðè îøèáêå. // ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-) -function SFSFileList (const dataFileName: TSFSString): TSFSFileList; +function SFSFileList (const dataFileName: AnsiString): TSFSFileList; -function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString; -// èãíîðèðóåò ðåãèñòð ñèìâîëîâ -function SFSStrEqu (const s0, s1: TSFSString): Boolean; +// çàïðåòèòü îñâîáîæäåíèå âðåìåííûõ òîìîâ (ìîæíî âûçûâàòü ðåêóðñèâíî) +procedure sfsGCDisable (); -// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà -// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî. -function SFSGetLastVirtualName (const fn: TSFSString): string; +// ðàçðåøèòü îñâîáîæäåíèå âðåìåííûõ òîìîâ (ìîæíî âûçûâàòü ðåêóðñèâíî) +procedure sfsGCEnable (); -// ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè -function Int64ToStrComma (i: Int64): string; +// for completeness sake +procedure sfsGCCollect (); -// `name` will be modified -// return `true` if file was found -function sfsFindFileCI (path: string; var name: string): Boolean; +function SFSReplacePathDelims (const s: AnsiString; newDelim: Char): AnsiString; + +// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà +// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî. +function SFSGetLastVirtualName (const fn: AnsiString): AnsiString; // Wildcard matching // this code is meant to allow wildcard pattern matches. tt is VERY useful @@ -230,16 +239,9 @@ function sfsFindFileCI (path: string; var name: string): Boolean; // 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would // not match 'this as a yest' // -function WildMatch (pattern, text: TSFSString): Boolean; -function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer; -function HasWildcards (const pattern: TSFSString): Boolean; - -// this will compare only last path element from sfspath -function SFSDFPathEqu (sfspath: string; path: string): Boolean; - -function SFSUpCase (ch: Char): Char; - -function utf8to1251 (s: TSFSString): TSFSString; +function WildMatch (pattern, text: AnsiString): Boolean; +function WildListMatch (wildList, text: AnsiString; delimChar: AnsiChar=':'): Integer; +function HasWildcards (const pattern: AnsiString): Boolean; var @@ -255,53 +257,13 @@ var // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|"). // çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"), // çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/"). - sfsDiskDirs: TSFSString = '|'; + sfsDiskDirs: AnsiString = '|'; implementation uses - xstreams; - - -function Int64ToStrComma (i: Int64): string; -var - f: Integer; -begin - Str(i, result); - f := Length(result)+1; - while f > 4 do - begin - Dec(f, 3); Insert(',', result, f); - end; -end; - - -// `name` will be modified -function sfsFindFileCI (path: string; var name: string): Boolean; -var - sr: TSearchRec; - bestname: string = ''; -begin - if length(path) = 0 then path := '.'; - while (length(path) > 0) and (path[length(path)] = '/') do Delete(path, length(path), 1); - if (length(path) = 0) or (path[length(path)] <> '/') then path := path+'/'; - if FileExists(path+name) then begin result := true; exit; end; - if FindFirst(path+'*', faAnyFile, sr) = 0 then - repeat - if (sr.name = '.') or (sr.name = '..') then continue; - if (sr.attr and faDirectory) <> 0 then continue; - if sr.name = name then - begin - FindClose(sr); - result := true; - exit; - end; - if (length(bestname) = 0) and SFSStrEqu(sr.name, name) then bestname := sr.name; - until FindNext(sr) <> 0; - FindClose(sr); - if length(bestname) > 0 then begin result := true; name := bestname; end else result := false; -end; + xstreams, utils; const @@ -316,7 +278,7 @@ const WILD_CHAR_RANGE_NOT = '!'; -function HasWildcards (const pattern: TSFSString): Boolean; +function HasWildcards (const pattern: AnsiString): Boolean; begin result := (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or @@ -326,7 +288,7 @@ begin (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0); end; -function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean; +function MatchMask (const pattern: AnsiString; p, pend: Integer; const text: AnsiString; t, tend: Integer): Boolean; var rangeStart, rangeEnd: AnsiChar; rangeNot, rangeMatched: Boolean; @@ -414,14 +376,14 @@ begin end; -function WildMatch (pattern, text: TSFSString): Boolean; +function WildMatch (pattern, text: AnsiString): Boolean; begin if pattern <> '' then pattern := AnsiLowerCase(pattern); if text <> '' then text := AnsiLowerCase(text); result := MatchMask(pattern, 1, -1, text, 1, -1); end; -function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer; +function WildListMatch (wildList, text: AnsiString; delimChar: AnsiChar=':'): Integer; var s, e: Integer; begin @@ -453,9 +415,10 @@ end; type TVolumeInfo = class + public fFactory: TSFSVolumeFactory; fVolume: TSFSVolume; - fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì! + fPackName: AnsiString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì! fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà @@ -478,13 +441,69 @@ type var factories: TObjectList; // TSFSVolumeFactory volumes: TObjectList; // TVolumeInfo + gcdisabled: Integer = 0; // >0: disabled + + +procedure sfsGCCollect (); +var + f, c: Integer; + vi: TVolumeInfo; + used: Boolean; +begin + // collect garbage + f := 0; + while f < volumes.Count do + begin + vi := TVolumeInfo(volumes[f]); + if (vi <> nil) and (not vi.fPermanent) and (vi.fOpenedFilesCount = 0) then + begin + // this volume probably can be removed + used := false; + c := volumes.Count-1; + while not used and (c >= 0) do + begin + if (c <> f) and (volumes[c] <> nil) then + begin + used := (TVolumeInfo(volumes[c]).fStream = vi.fStream); + if not used then used := (TVolumeInfo(volumes[c]).fVolume.fFileStream = vi.fStream); + if used then break; + end; + Dec(c); + end; + if not used then + begin + {$IFDEF SFS_VOLDEBUG}writeln('000: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF} + volumes.extract(vi); // remove from list + vi.Free; // and kill + f := 0; + continue; + end; + end; + Inc(f); // next volume + end; +end; + +procedure sfsGCDisable (); +begin + Inc(gcdisabled); +end; + +procedure sfsGCEnable (); +begin + Dec(gcdisabled); + if gcdisabled <= 0 then + begin + gcdisabled := 0; + sfsGCCollect(); + end; +end; // ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ, // ñîáñòâåííî èìÿ ôàéëà // èìÿ âûãëÿäèò êàê: // (("sfspfx:")?"datafile::")*"filename" -procedure SplitFName (const fn: string; out dataFile, fileName: string); +procedure SplitFName (const fn: AnsiString; out dataFile, fileName: AnsiString); var f: Integer; begin @@ -503,7 +522,7 @@ begin end; // ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile. -function ExtractVirtName (var dataFile: string): string; +function ExtractVirtName (var dataFile: AnsiString): AnsiString; var f: Integer; begin @@ -531,7 +550,7 @@ end; // [sfspfx:]datafile[|virtname] // åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì, // à èìåíåì äèñêà. -procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string); +procedure SplitDataName (const fn: AnsiString; out pfx, dataFile, virtName: AnsiString); var f: Integer; begin @@ -547,7 +566,7 @@ end; // íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò). // onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè. -function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer; +function FindVolumeInfo (const dataFileName: AnsiString; onlyPerm: Boolean=false): Integer; var f: Integer; vi: TVolumeInfo; @@ -560,7 +579,7 @@ begin vi := TVolumeInfo(volumes[f]); if not onlyPerm or vi.fPermanent then begin - if SFSStrEqu(vi.fPackName, dataFileName) then + if StrEquCI1251(vi.fPackName, dataFileName) then begin result := f; exit; @@ -587,66 +606,9 @@ begin end; end; -function SFSUpCase (ch: Char): Char; -begin - if ch < #128 then - begin - if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32); - end - else - begin - if (ch >= #224) and (ch <= #255) then - begin - Dec(ch, 32); - end - else - begin - case ch of - #184, #186, #191: Dec(ch, 16); - #162, #179: Dec(ch); - end; - end; - end; - result := ch; -end; - -function SFSStrEqu (const s0, s1: TSFSString): Boolean; -var - i: Integer; -begin - //result := (AnsiCompareText(s0, s1) == 0); - result := false; - if length(s0) <> length(s1) then exit; - for i := 1 to length(s0) do - begin - if SFSUpCase(s0[i]) <> SFSUpCase(s1[i]) then exit; - end; - result := true; -end; - -// this will compare only last path element from sfspath -function SFSDFPathEqu (sfspath: string; path: string): Boolean; -{var - i: Integer;} -begin - result := SFSStrEqu(sfspath, path); -(* - if not result and (length(sfspath) > 1) then - begin - i := length(sfspath); - while i > 1 do - begin - while (i > 1) and (sfspath[i-1] <> '/') do Dec(i); - if i <= 1 then exit; - writeln('{', sfspath, '} [', Copy(sfspath, i, length(sfspath)), '] : [', path, ']'); - result := SFSStrEqu(Copy(sfspath, i, length(sfspath)), path); - end; - end; -*) -end; // adds '/' too -function normalizePath (fn: string): string; +function normalizePath (fn: AnsiString): AnsiString; var i: Integer; begin @@ -672,7 +634,7 @@ begin if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/'; end; -function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString; +function SFSReplacePathDelims (const s: AnsiString; newDelim: Char): AnsiString; var f: Integer; begin @@ -687,9 +649,9 @@ begin end; end; -function SFSGetLastVirtualName (const fn: TSFSString): string; +function SFSGetLastVirtualName (const fn: AnsiString): AnsiString; var - rest, tmp: string; + rest, tmp: AnsiString; f: Integer; begin rest := fn; @@ -708,7 +670,7 @@ var used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸ begin if fFactory <> nil then fFactory.Recycle(fVolume); - if fVolume <> nil then used := (fVolume.fRC <> 0) else used := false; + used := false; fVolume := nil; fFactory := nil; fPackName := ''; @@ -754,12 +716,12 @@ begin if fOwner <> nil then begin Dec(fOwner.fOpenedFilesCount); - if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then + if (gcdisabled = 0) and not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then begin f := volumes.IndexOf(fOwner); if f <> -1 then begin - {$IFDEF SFS_VOLDEBUG}writeln('destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF} + {$IFDEF SFS_VOLDEBUG}writeln('001: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF} volumes[f] := nil; // this will destroy the volume end; end; @@ -787,24 +749,19 @@ end; { TSFSVolume } -constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream); +constructor TSFSVolume.Create (const pFileName: AnsiString; pSt: TStream); begin inherited Create(); - fRC := 0; fFileStream := pSt; fFileName := pFileName; fFiles := TObjectList.Create(true); end; -procedure TSFSVolume.removeCommonPath (); -begin -end; - procedure TSFSVolume.DoDirectoryRead (); var f, c: Integer; sfi: TSFSFileInfo; - tmp: TSFSString; + tmp: AnsiString; begin fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/')); ReadDirectory(); @@ -831,7 +788,6 @@ begin sfi.fPath := normalizePath(sfi.fPath); if (length(sfi.fPath) = 0) and (length(sfi.fName) = 0) then sfi.Free else Inc(f); end; - removeCommonPath(); end; destructor TSFSVolume.Destroy (); @@ -843,11 +799,10 @@ end; procedure TSFSVolume.Clear (); begin - fRC := 0; //FIXME fFiles.Clear(); end; -function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer; +function TSFSVolume.FindFile (const fPath, fName: AnsiString): Integer; begin if fFiles = nil then result := -1 else @@ -858,8 +813,8 @@ begin Dec(result); if fFiles[result] <> nil then begin - if SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and - SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) then exit; + if StrEquCI1251(fPath, TSFSFileInfo(fFiles[result]).fPath) and + StrEquCI1251(fName, TSFSFileInfo(fFiles[result]).fName) then exit; end; end; result := -1; @@ -881,9 +836,9 @@ begin end; end; -function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream; +function TSFSVolume.OpenFileEx (const fName: AnsiString): TStream; var - fp, fn: TSFSString; + fp, fn: AnsiString; f, ls: Integer; begin fp := fName; @@ -923,12 +878,11 @@ var begin f := FindVolumeInfoByVolumeInstance(fVolume); ASSERT(f <> -1); - if fVolume <> nil then Dec(fVolume.fRC); Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount); // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî - if not TVolumeInfo(volumes[f]).fPermanent and (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then + if (gcdisabled = 0) and not TVolumeInfo(volumes[f]).fPermanent and (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then begin - {$IFDEF SFS_VOLDEBUG}writeln('destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF} + {$IFDEF SFS_VOLDEBUG}writeln('002: destroying volume "', TVolumeInfo(volumes[f]).fPackName, '"');{$ENDIF} volumes[f] := nil; end; inherited Destroy(); @@ -974,7 +928,7 @@ begin end; -function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream; top, permanent: Integer): Integer; +function SFSAddDataFileEx (dataFileName: AnsiString; ds: TStream; top, permanent: Integer): Integer; // dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix). // ìîæåò âûêèíóòü èñêëþ÷åíèå! // top: @@ -995,8 +949,8 @@ var vi: TVolumeInfo; f: Integer; st, st1: TStream; - pfx: TSFSString; - fn, vfn, tmp: TSFSString; + pfx: AnsiString; + fn, vfn, tmp: AnsiString; begin f := Pos('::', dataFileName); if f <> 0 then @@ -1023,7 +977,7 @@ begin except FreeAndNil(st); // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì. - if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil; + if (gcdisabled = 0) and not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil; raise; end; // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå. @@ -1054,7 +1008,7 @@ begin end; if ds <> nil then st := ds - else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite); + else st := TFileStream.Create(fn, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone); st.Position := 0; volumes.Pack(); @@ -1105,7 +1059,7 @@ begin vi.fOpenedFilesCount := 0; end; -function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean; +function SFSAddSubDataFile (const virtualName: AnsiString; ds: TStream; top: Boolean=false): Boolean; var tv: Integer; begin @@ -1119,7 +1073,7 @@ begin end; end; -function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean; +function SFSAddDataFile (const dataFileName: AnsiString; top: Boolean=false): Boolean; var tv: Integer; begin @@ -1132,7 +1086,7 @@ begin end; end; -function SFSAddDataFileTemp (const dataFileName: TSFSString; top: Boolean=false): Boolean; +function SFSAddDataFileTemp (const dataFileName: AnsiString; top: Boolean=false): Boolean; var tv: Integer; begin @@ -1147,10 +1101,10 @@ end; -function SFSExpandDirName (const s: TSFSString): TSFSString; +function SFSExpandDirName (const s: AnsiString): AnsiString; var f, e: Integer; - es: TSFSString; + es: AnsiString; begin f := 1; result := s; while f < Length(result) do @@ -1175,9 +1129,9 @@ begin end; end; -function SFSFileOpenEx (const fName: TSFSString): TStream; +function SFSFileOpenEx (const fName: AnsiString): TStream; var - dataFileName, fn: TSFSString; + dataFileName, fn: AnsiString; f: Integer; vi: TVolumeInfo; diskChecked: Boolean; @@ -1186,7 +1140,7 @@ var function CheckDisk (): TStream; // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ. var - dfn, dirs, cdir: TSFSString; + dfn, dirs, cdir: AnsiString; f: Integer; begin result := nil; @@ -1202,7 +1156,7 @@ var cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/'); if cdir[Length(cdir)] <> '/' then cdir := cdir+'/'; try - result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite); + result := TFileStream.Create(cdir+dfn, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone); exit; except end; @@ -1232,7 +1186,7 @@ begin ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true); except result.Free(); - if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; + if (gcdisabled = 0) and not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê if result = nil then raise ESFSError.Create('file not found: "'+fName+'"'); exit; @@ -1277,7 +1231,7 @@ begin if result = nil then raise ESFSError.Create('file not found: "'+fName+'"'); end; -function SFSFileOpen (const fName: TSFSString): TStream; +function SFSFileOpen (const fName: AnsiString): TStream; begin try result := SFSFileOpenEx(fName); @@ -1286,7 +1240,7 @@ begin end; end; -function SFSFileList (const dataFileName: TSFSString): TSFSFileList; +function SFSFileList (const dataFileName: AnsiString): TSFSFileList; var f: Integer; vi: TVolumeInfo; @@ -1303,131 +1257,12 @@ begin try result := TSFSFileList.Create(vi.fVolume); - Inc(vi.fVolume.fRC); except - if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; + if (gcdisabled = 0) and not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; end; end; -// ////////////////////////////////////////////////////////////////////////// // -// utils -// `ch`: utf8 start -// -1: invalid utf8 -function utf8CodeLen (ch: Word): Integer; -begin - if ch < $80 then begin result := 1; exit; end; - if (ch and $FE) = $FC then begin result := 6; exit; end; - if (ch and $FC) = $F8 then begin result := 5; exit; end; - if (ch and $F8) = $F0 then begin result := 4; exit; end; - if (ch and $F0) = $E0 then begin result := 3; exit; end; - if (ch and $E0) = $C0 then begin result := 2; exit; end; - result := -1; // invalid -end; - - -function utf8Valid (s: string): Boolean; -var - pos, len: Integer; -begin - result := false; - pos := 1; - while pos <= length(s) do - begin - len := utf8CodeLen(Byte(s[pos])); - if len < 1 then exit; // invalid sequence start - if pos+len-1 > length(s) then exit; // out of chars in string - Dec(len); - Inc(pos); - // check other sequence bytes - while len > 0 do - begin - if (Byte(s[pos]) and $C0) <> $80 then exit; - Dec(len); - Inc(pos); - end; - end; - result := true; -end; - - -// ////////////////////////////////////////////////////////////////////////// // -const - // TODO: move this to a separate file - uni2wint: array [128..255] of Word = ( - $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, - $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, - $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, - $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, - $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, - $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F, - $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, - $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F - ); - - -function decodeUtf8Char (s: TSFSString; var pos: Integer): char; -var - b, c: Integer; -begin - (* The following encodings are valid, except for the 5 and 6 byte - * combinations: - * 0xxxxxxx - * 110xxxxx 10xxxxxx - * 1110xxxx 10xxxxxx 10xxxxxx - * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - *) - result := '?'; - if pos > length(s) then exit; - - b := Byte(s[pos]); - Inc(pos); - if b < $80 then begin result := char(b); exit; end; - - // mask out unused bits - if (b and $FE) = $FC then b := b and $01 - else if (b and $FC) = $F8 then b := b and $03 - else if (b and $F8) = $F0 then b := b and $07 - else if (b and $F0) = $E0 then b := b and $0F - else if (b and $E0) = $C0 then b := b and $1F - else exit; // invalid utf8 - - // now continue - while pos <= length(s) do - begin - c := Byte(s[pos]); - if (c and $C0) <> $80 then break; // no more - b := b shl 6; - b := b or (c and $3F); - Inc(pos); - end; - - // done, try 1251 - for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end; - // alas -end; - - -function utf8to1251 (s: TSFSString): TSFSString; -var - pos: Integer; -begin - if not utf8Valid(s) then begin result := s; exit; end; - pos := 1; - while pos <= length(s) do - begin - if Byte(s[pos]) >= $80 then break; - Inc(pos); - end; - if pos > length(s) then begin result := s; exit; end; // nothing to do here - result := ''; - pos := 1; - while pos <= length(s) do result := result+decodeUtf8Char(s, pos); -end; - - initialization factories := TObjectList.Create(true); volumes := TObjectList.Create(true);