{ Virtual File System. Overlay identifiziert über Layer-Nummer (oder direkt als Overlay-Objekt) UnionFS: Shadowing, höhere Overlay überdecken untere Lesen: oberste existierende Datei wird abgerufen Schreiben: Nur direkt über Layer; ggf. via Layer ID abrufbar Mountpunkte werden prefix-artig verwendet; erlauben das Verwenden von Datenquellen als Unterverzeichnisse } unit uvfsManager; interface uses Classes, SysUtils, Contnrs; type TvfsLayer = type Word; // größere Werte überdecken kleinere TvfsFileInfo = record Size: Int64; Attributes: Integer; ModDate: TDateTime; end; TvfsOverlay = class; TvfsDirectoryList = class; TvfsListingOptions = set of (loLayer, loPath, loRecursive, loFilter, loAttrib); TvfsDirectoryEntry = class Source: TvfsOverlay; FileInfo: TvfsFileInfo; end; EvfsError = class(Exception); IStreamHandle = interface ['{57F8D713-B231-4268-81CA-EE3CE25664FE}'] function GetStream: TStream; end; TvfsDirectoryAddFunc = procedure (FileName: string; Entry: TvfsDirectoryEntry; List: TvfsDirectoryList) of object; { TvfsStreamHandleRead } TvfsStreamHandleRead = class(TInterfacedObject, IStreamHandle) private fStream: TStream; public constructor Create(aStream: TStream); destructor Destroy; override; function GetStream: TStream; end; { TvfsStreamHandleWrite } TvfsStreamHandleWrite = class; TvfsWriteFunc = procedure(Handle: TvfsStreamHandleWrite; Data: Pointer; DataSize: integer) of object; TvfsStreamHandleWrite = class(TvfsStreamHandleRead) private fData: Pointer; fSize: Integer; fFlushFunction: TvfsWriteFunc; public constructor Create(aStream: TStream; aFlushFunction: TvfsWriteFunc; Data: Pointer; DataSize: integer); destructor Destroy; override; end; (* Alles, was mit den wirklichen Daten spricht ist von [TvfsProvider] abgeleitet. * * Methoden: * FileExists - Existiert diese Datei? * Open - Öffnen einer Datei, siehe TvfsFileOpenMode * Rename - Datei oder Verzeichnis umbenennen * DirectoryIndex - Alle verfügbaren Dateien listen. * StorageName - Name, unter dem dieser Provider in VFSTAB geführt wird * StorageGetData - Daten für das ExtendedData-Feld der VFSTAB erzeugen * * Dateinamen sind immer relativ auf den Mountpunkt, also FileSpec im Konstruktor *) { TvfsProvider } TvfsFileOpenMode = (omReadOnly, // read-only, fail if not exists omReadWrite, // read/write, fail if not exists omReadWriteCreate, // read/write, create if not exists omCreateAlways); // read/write, always create empty TvfsProvider = class // Achievement Get: WTF FPC? -- virtueller Konstruktor, damit "class of" funktioniert, H- damit der leere Body keine Warnungen spammt constructor Create(const {%H-}FileSpec: string; const {%H-}ExtendedData: string=''); virtual; function GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): boolean; virtual; abstract; function Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean; virtual; abstract; function Rename(const OldName, NewName: string): boolean; virtual; abstract; function Delete(const aName: String): boolean; virtual; abstract; procedure DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean); virtual; abstract; class function StorageName: string; virtual; abstract; function StorageGetFileSpec: string; virtual; abstract; function StorageGetData: string; virtual; end; TvfsProviderClass = class of TvfsProvider; { TvfsOverlay } TvfsOverlay = class private FListingAttrib: integer; FListingFilter: string; procedure DirectoryAdd(FileName: string; Entry: TvfsDirectoryEntry; List: TvfsDirectoryList); public Layer: TvfsLayer; Provider: TvfsProvider; Mountpoint: string; function TranslatePath(const FileName: string; out RelativeName: string): boolean; constructor Create(aLayer: TvfsLayer; aProvider: TvfsProvider; aMountpoint: string); destructor Destroy; override; function GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): boolean; function OpenRead(const FileName: string; out Stream: IStreamHandle): boolean; function OpenWrite(const FileName: string; const CanCreate: boolean; out Stream: IStreamHandle): boolean; function CreateFile(const FileName: string; out Stream: IStreamHandle): boolean; function Rename(const OldName, NewName: string): boolean; function Delete(const aName: String): Boolean; procedure Listing(List: TvfsDirectoryList; const Options: TvfsListingOptions; const Path: string; const Filter: string; const Attrib: integer); end; TvfsDirectoryList = class(TStringList) private function GetEntry(Index: Integer): TvfsDirectoryEntry; protected procedure ClearObjects; public destructor Destroy; override; procedure Delete(Index: Integer); override; procedure Clear; override; property Entry[Index: Integer]: TvfsDirectoryEntry read GetEntry; // Eintrag einfügen. Im Fall eines Duplikats wird AObject direkt freigegeben function AddEntry(const S: String; AObject: TvfsDirectoryEntry): Integer; end; (* * Here's the magic :) *) { TvfsManager } TvfsManager = class private FLayers: TObjectList; function LocateFile(const Filename: string; const FilterLayer: boolean; const Layer: TvfsLayer): TvfsOverlay; function GetCount: integer; function GetOverlay(Index: integer): TvfsOverlay; protected FRegisteredProviders: TClassList; procedure InsertOverlay(Overlay: TvfsOverlay); public constructor Create; destructor Destroy; override; // Overlay hinzufügen function AddOverlay(const Layer: TvfsLayer; const Mountpoint: string; Provider: TvfsProvider): TvfsOverlay; overload; // Overlay (vollständig) entfernen procedure Remove(const Layer: TvfsLayer); overload; procedure Remove(const Overlay: TvfsOverlay); overload; procedure RemoveAll; // Zugriff auf den obersten Overlay mit dieser LayerID function FindOverlay(const Layer: TvfsLayer): TvfsOverlay; // Direktzugriff auf Provider property OverlayCount: integer read GetCount; property Overlay[Index: integer]: TvfsOverlay read GetOverlay; // Verzeichnislisting // List -> muss vorher erstellt werden // Options: loRecursive, sonst gibts nur das gewählte Verzeichnis (oder Root, wenn loPath nicht verwendet wird) // andere Options aktivieren die Parameter procedure Listing(List: TvfsDirectoryList; const Options: TvfsListingOptions; const Layer: TvfsLayer = 0; const Path: string = ''; const Filter: string = '*.*'; const Attrib: integer = 0); // Datei aus der obersten Ebene lesen. function FileExists(const FileName: String): Boolean; function DirectoryExists(const FileName: String): Boolean; function ReadFile(const Filename: string; out Stream: IStreamHandle): Boolean; function WriteFile(const Filename: String; const CanCreate: boolean; out Stream: IStreamHandle): Boolean; function CreateFile(const Filename: String; out Stream: IStreamHandle): Boolean; function DeleteFile(const Filename: String): Integer; function RenameFile(const aOld, aNew: String): Integer; function ImmediateOverlay(const Filename: string): TvfsOverlay; // Provider registrieren procedure RegisterProvider(const ClassRef: TvfsProviderClass); // Provider zum Storage-Name suchen, nil wenn keiner gefunden function FindProvider(const StorageName: string): TvfsProviderClass; // Provider nach Einfügereihenfolge, nil wenn Index ungültig function GetProvider(const Index: integer): TvfsProviderClass; // Konfigurationsdaten speichern procedure SaveConfigFile(const Filename: string; PathBase: string=''); // Konfigurationsdaten dazuladen procedure ApplyConfigFile(const Filename: string; PathBase: string=''); end; const VFS_PATH_DELIM = '/'; operator := (hdl: IStreamHandle): TStream; function vfsManager: TvfsManager; function vfsSystemPathDelim(s: String): string; function vfsVirtualPathDelim(s: String): string; function vfsChangePathDelim(s: String; const newPathDelim: char): string; function vfsExpandFileName(const Filename, Base: string): string; function vfsFileNameLike(const AString, APattern: String): Boolean; function vfsFileNameGlob(const AString, APattern: String): Boolean; implementation uses uutlCommon; const VFSTAB_COMMENT = '#'; VFSTAB_QUOTE = '"'; VFSTAB_SEPARATOR = #9; operator:=(hdl: IStreamHandle): TStream; begin Result:= hdl.GetStream; end; var VFSSingleton: TvfsManager = nil; function vfsManager: TvfsManager; begin if not Assigned(VFSSingleton) then VFSSingleton:= TvfsManager.Create; Result:= VFSSingleton; end; function vfsSystemPathDelim(s: String): string; var i:integer; begin for i:= 1 to Length(s) do if s[i] in ['\','/'] then s[i]:= PathDelim; Result:= S; end; function vfsVirtualPathDelim(s: String): string; var i:integer; begin for i:= 1 to Length(s) do if s[i] in ['\','/'] then s[i]:= VFS_PATH_DELIM; Result:= S; end; function vfsChangePathDelim(s: String; const newPathDelim: char): string; var i:integer; begin for i:= 1 to Length(s) do if s[i] in ['\','/'] then s[i]:= newPathDelim; Result:= S; end; function vfsExpandFileName(const Filename, Base: string): string; begin {$IF defined(WIN32) or defined(WIN64)} if (ExtractFileDrive(Filename)>'') then {$ELSE} if (Copy(Filename,1,1)=PathDelim) then {$IFEND} Result:= Filename else Result:= IncludeTrailingPathDelimiter(Base)+Filename; end; { Like('Delphi', 'D*p?i') -> true.} {Michael Winter} function Like(const AString, APattern: String): Boolean; var StringPtr, PatternPtr: PChar; StringRes, PatternRes: PChar; begin Result:=false; StringPtr:=PChar(AString); PatternPtr:=PChar(APattern); StringRes:=nil; PatternRes:=nil; if APattern='*' then begin Result:= true; exit end; repeat repeat // ohne vorangegangenes "*" case PatternPtr^ of #0: begin Result:=StringPtr^=#0; if Result or (StringRes=nil) or (PatternRes=nil) then Exit; StringPtr:=StringRes; PatternPtr:=PatternRes; Break; end; '*': begin inc(PatternPtr); PatternRes:=PatternPtr; Break; end; '?': begin if StringPtr^=#0 then Exit; inc(StringPtr); inc(PatternPtr); end; else begin if StringPtr^=#0 then Exit; if StringPtr^<>PatternPtr^ then begin if (StringRes=nil) or (PatternRes=nil) then Exit; StringPtr:=StringRes; PatternPtr:=PatternRes; Break; end else begin inc(StringPtr); inc(PatternPtr); end; end; end; until false; repeat // mit vorangegangenem "*" case PatternPtr^ of #0: begin Result:=true; Exit; end; '*': begin inc(PatternPtr); PatternRes:=PatternPtr; end; '?': begin if StringPtr^=#0 then Exit; inc(StringPtr); inc(PatternPtr); end; else begin repeat if StringPtr^=#0 then Exit; if StringPtr^=PatternPtr^ then Break; inc(StringPtr); until false; inc(StringPtr); StringRes:=StringPtr; inc(PatternPtr); Break; end; end; until false; until false; end; function vfsFileNameLike(const AString, APattern: String): Boolean; begin Result:= Like(AnsiLowerCaseFileName(AString), AnsiLowerCaseFileName(APattern)); end; function GlobMatchPattern(Str, Pattern: PChar): boolean; var pe: PChar; sp: TStringList; pp: string; begin Result:= false; if (Str^=#0) or (Pattern^=#0) then Exit(Str^ = Pattern^); case Pattern^ of '?': ; //can't be wrong, since we already know we have at least one character left '*': begin inc(Pattern); repeat inc(Str); until (Str^= #0) or GlobMatchPattern(Str, Pattern); if (Str^= #0) then Exit(StrLen(Pattern) = 0); end; '{': begin inc(Pattern); pe:= strscan(Pattern, '}'); if pe = nil then Exit(false); sp:= TStringList.Create; try sp.Delimiter:= ','; sp.DelimitedText:= Copy(Pattern, 1, {%H-}PtrUInt(pe)-{%H-}PtrUInt(Pattern)); inc(pe); Pattern:= pe; for pp in sp do if GlobMatchPattern(Str, PChar(pp + Pattern)) then Exit(true); Exit(false); finally FreeAndNil(sp); end; end else if Pattern^ <> Str^ then Exit(false); end; inc(Pattern); inc(Str); Result:= GlobMatchPattern(Str, Pattern); end; function vfsFileNameGlob(const AString, APattern: String): Boolean; begin Result:= GlobMatchPattern(PChar(AString), PChar(APattern)); end; { TvfsStreamHandleRead } constructor TvfsStreamHandleRead.Create(aStream: TStream); begin inherited Create; fStream:= aStream; end; destructor TvfsStreamHandleRead.Destroy; begin fStream.Free; fStream:= nil; inherited Destroy; end; function TvfsStreamHandleRead.GetStream: TStream; begin Result:= fStream; end; { TvfsStreamHandleWrite } constructor TvfsStreamHandleWrite.Create(aStream: TStream; aFlushFunction: TvfsWriteFunc; Data: Pointer; DataSize: integer); begin inherited Create(aStream); fFlushFunction:= aFlushFunction; if Assigned(Data) and (DataSize>0) then begin GetMem(fData, DataSize); Move(Data^, fData^, DataSize); end else fData:= nil; fSize:= DataSize; end; destructor TvfsStreamHandleWrite.Destroy; begin if Assigned(fFlushFunction) then fFlushFunction(Self, fData, fSize); if Assigned(fData) then Freememory(fData); inherited Destroy; end; { TvfsProvider } constructor TvfsProvider.Create(const FileSpec: string; const ExtendedData: string); begin inherited Create; end; function TvfsProvider.StorageGetData: string; begin Result:= ''; end; { TvfsOverlay } constructor TvfsOverlay.Create(aLayer: TvfsLayer; aProvider: TvfsProvider; aMountpoint: string); var mp: string; begin Layer:= aLayer; Provider:= aProvider; mp:= vfsSystemPathDelim(aMountpoint); mp:= IncludeTrailingPathDelimiter(mp); while (mp>'') and (mp[1]=PathDelim) do System.Delete(mp, 1, 1); Self.Mountpoint:= mp; end; destructor TvfsOverlay.Destroy; begin FreeAndNil(Provider); inherited; end; function TvfsOverlay.GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): boolean; var fn: string; begin Result:= TranslatePath(Filename, fn) and Provider.GetFileInfo(fn, FileInfo); end; function TvfsOverlay.OpenRead(const FileName: string; out Stream: IStreamHandle): boolean; var fn: string; begin Result:= TranslatePath(Filename, fn) and Provider.Open(fn, omReadOnly, Stream); end; function TvfsOverlay.OpenWrite(const FileName: string; const CanCreate: boolean; out Stream: IStreamHandle): boolean; const OpenModes:array[Boolean] of TvfsFileOpenMode = (omReadWrite, omReadWriteCreate); var fn: string; begin Result:= TranslatePath(Filename, fn) and Provider.Open(fn, OpenModes[CanCreate], Stream); end; function TvfsOverlay.CreateFile(const FileName: string; out Stream: IStreamHandle): boolean; var fn: string; begin Result:= TranslatePath(Filename, fn) and Provider.Open(fn, omCreateAlways, Stream); end; function TvfsOverlay.Rename(const OldName, NewName: string): boolean; var fon, fnn: string; begin Result:= TranslatePath(OldName, fon) and TranslatePath(NewName, fnn) and Provider.Rename(fon, fnn); end; function TvfsOverlay.Delete(const aName: String): Boolean; var fName: string; begin Result := TranslatePath(aName, fName) and Provider.Delete(fName); end; procedure TvfsOverlay.Listing(List: TvfsDirectoryList; const Options: TvfsListingOptions; const Path: string; const Filter: string; const Attrib: integer); var subpath: string; e: TvfsDirectoryEntry; m: string; begin subpath:= vfsSystemPathDelim(IncludeTrailingPathDelimiter(Path)); if not (loPath in Options) or TranslatePath(Path, subpath) then begin m:= vfsSystemPathDelim(Mountpoint); while m>'' do begin if (not (loPath in Options)) or (0=AnsiCompareStr(Path, Copy(m, 1, Length(Path)))) then begin e:= TvfsDirectoryEntry.Create; e.FileInfo.Attributes:= faDirectory or faSymLink{%H-}; e.FileInfo.ModDate:= 0; e.FileInfo.Size:= 0; e.Source:= Self; List.AddEntry(m, e); end; System.Delete(m, Length(m),1); m:= copy(m, 1, LastDelimiter(PathDelim, m)); end; if loAttrib in Options then FListingAttrib:= Attrib else FListingAttrib:= Integer($FFFFFFFF); if loFilter in Options then FListingFilter:= Filter else FListingFilter:= '*'; if not (loPath in Options) then subpath:= ''; Provider.DirectoryIndex({$IFDEF FPC}@{$ENDIF}DirectoryAdd, List, subpath, loRecursive in Options); end; end; procedure TvfsOverlay.DirectoryAdd(FileName: string; Entry: TvfsDirectoryEntry; List: TvfsDirectoryList); var fn: string; begin Entry.Source:= Self; fn:= ExtractFileName(FileName); if ((FListingAttrib and Entry.FileInfo.Attributes) > 0) and // Attrib passt ({(Entry.FileInfo.Attributes and faDirectory >0) or } // Ist Verzeichnis, oder... ACHTUNG!!! vorerst deaktiviert. KP warum das so drin war... vfsFileNameLike(fn, FListingFilter)) then // ...DATEIname passt auf Maske List.AddEntry(vfsVirtualPathDelim(Mountpoint+Filename), Entry) else Entry.Free; end; function TvfsOverlay.TranslatePath(const FileName: string; out RelativeName: string): boolean; var ff: string; begin ff:= Copy(vfsSystemPathDelim(FileName),1, Length(Mountpoint)); Result:= 0 = AnsiCompareText(ff, Mountpoint); if Result then RelativeName:= Copy(vfsSystemPathDelim(FileName),length(ff)+1, Maxint); end; { TvfsDirectoryList } destructor TvfsDirectoryList.Destroy; begin ClearObjects; inherited; end; procedure TvfsDirectoryList.Clear; begin ClearObjects; inherited; end; procedure TvfsDirectoryList.Delete(Index: Integer); var f: TvfsDirectoryEntry; begin f:= TvfsDirectoryEntry(Objects[Index]); Objects[Index]:= nil; F.Free; inherited; end; procedure TvfsDirectoryList.ClearObjects; var i: integer; f: TvfsDirectoryEntry; begin for i:= 0 to Count-1 do begin f:= TvfsDirectoryEntry(Objects[i]); Objects[i]:= nil; F.Free; end; end; function TvfsDirectoryList.GetEntry(Index: Integer): TvfsDirectoryEntry; begin Result:= TvfsDirectoryEntry(Objects[Index]); end; function TvfsDirectoryList.AddEntry(const S: String; AObject: TvfsDirectoryEntry): Integer; begin if IndexOf(S)>=0 then begin Result:= -1; AObject.Free; end else Result:= AddObject(S, AObject); end; { TvfsManager } constructor TvfsManager.Create; begin inherited Create; FLayers:= TObjectList.Create(true); FRegisteredProviders:= TClassList.Create; end; destructor TvfsManager.Destroy; begin FreeAndNil(FRegisteredProviders); FreeAndNil(FLayers); inherited; end; function TvfsManager.AddOverlay(const Layer: TvfsLayer; const Mountpoint: string; Provider: TvfsProvider): TvfsOverlay; var ol: TvfsOverlay; begin Result:= nil; ol:= TvfsOverlay.Create(Layer, Provider, Mountpoint); try InsertOverlay(ol); Result:= ol; except FreeAndNil(ol); raise; end; end; procedure TvfsManager.InsertOverlay(Overlay: TvfsOverlay); var i: integer; begin // add on top of the matching layer for i:= 0 to FLayers.Count-1 do begin if TvfsOverlay(FLayers[i]).Layer > Overlay.Layer then begin FLayers.Insert(i, Overlay); Exit; end; end; // not inserted anything? then new layer is larger than anything before FLayers.Add(Overlay); end; function TvfsManager.LocateFile(const Filename: string; const FilterLayer: boolean; const Layer: TvfsLayer): TvfsOverlay; var i: integer; ol: TvfsOverlay; dummy: TvfsFileInfo; begin Result:= nil; for i:= FLayers.Count-1 downto 0 do begin ol:= TvfsOverlay(FLayers[i]); if not FilterLayer or (ol.Layer=Layer) then begin if ol.GetFileInfo(FileName, dummy) then begin Result:= ol; exit; end; end; end; end; function TvfsManager.ReadFile(const Filename: string; out Stream: IStreamHandle): Boolean; var ol: TvfsOverlay; begin ol:= LocateFile(Filename,false,0); Result:= Assigned(ol) and ol.OpenRead(FileName, Stream); end; function TvfsManager.WriteFile(const Filename: String; const CanCreate: boolean; out Stream: IStreamHandle): Boolean; var ol: TvfsOverlay; begin ol := ImmediateOverlay(Filename); result := Assigned(ol) and ol.OpenWrite(Filename, CanCreate, Stream); end; function TvfsManager.CreateFile(const Filename: String; out Stream: IStreamHandle): Boolean; var ol: TvfsOverlay; begin ol := ImmediateOverlay(Filename); result := Assigned(ol) and ol.CreateFile(Filename, Stream); end; function TvfsManager.DeleteFile(const Filename: String): Integer; var i: integer; ol: TvfsOverlay; d: string; begin result := 0; for i := FLayers.Count-1 downto 0 do begin ol := TvfsOverlay(FLayers[i]); if ol.TranslatePath(Filename, d) then begin if ol.Delete(Filename) then inc(result); end; end; end; function TvfsManager.RenameFile(const aOld, aNew: String): Integer; var i: integer; ol: TvfsOverlay; d: string; begin result := 0; for i := FLayers.Count-1 downto 0 do begin ol := TvfsOverlay(FLayers[i]); if ol.TranslatePath(aOld, d) and ol.TranslatePath(aNew, d) then begin if ol.Rename(aOld, aNew) then inc(result); end; end; end; function TvfsManager.ImmediateOverlay(const Filename: string): TvfsOverlay; var i: integer; ol: TvfsOverlay; d: string; begin Result:= nil; for i:= FLayers.Count-1 downto 0 do begin ol:= TvfsOverlay(FLayers[i]); if ol.TranslatePath(Filename, d) then begin Result:= ol; exit; end; end; end; procedure TvfsManager.Remove(const Layer: TvfsLayer); var i: integer; begin for i:= FLayers.Count-1 downto 0 do if TvfsOverlay(FLayers[i]).Layer=Layer then FLayers.Delete(i); end; procedure TvfsManager.Remove(const Overlay: TvfsOverlay); begin FLayers.Remove(Overlay); end; procedure TvfsManager.RemoveAll; begin FLayers.Clear; end; function TvfsManager.FindOverlay(const Layer: TvfsLayer): TvfsOverlay; var i: integer; begin Result:= nil; for i:= FLayers.Count-1 downto 0 do if TvfsOverlay(FLayers[i]).Layer=Layer then begin Result:= TvfsOverlay(FLayers[i]); exit; end; end; procedure TvfsManager.Listing(List: TvfsDirectoryList; const Options: TvfsListingOptions; const Layer: TvfsLayer; const Path: string; const Filter: string; const Attrib: integer); var i: integer; begin List.Sorted:= true; List.Duplicates:= dupIgnore; for i:= FLayers.Count-1 downto 0 do if not (loLayer in Options) or (TvfsOverlay(FLayers[i]).Layer=Layer) then begin TvfsOverlay(FLayers[i]).Listing(List, Options - [loLayer], Path, Filter, Attrib); end; end; function TvfsManager.FileExists(const FileName: String): Boolean; var ol: TvfsOverlay; fi: TvfsFileInfo; begin ol:= LocateFile(Filename,false,0); Result:= Assigned(ol) and ol.GetFileInfo(FileName, fi) and ((fi.Attributes and faDirectory)=0); end; function TvfsManager.DirectoryExists(const FileName: String): Boolean; var ol: TvfsOverlay; fi: TvfsFileInfo; begin ol:= LocateFile(Filename,false,0); Result:= Assigned(ol) and ol.GetFileInfo(FileName, fi) and ((fi.Attributes and faDirectory)>0); end; function TvfsManager.GetCount: integer; begin Result:= FLayers.Count; end; function TvfsManager.GetOverlay(Index: integer): TvfsOverlay; begin Result:= TvfsOverlay(FLayers[Index]); end; procedure TvfsManager.RegisterProvider(const ClassRef: TvfsProviderClass); begin if Assigned(ClassRef) and (FRegisteredProviders.IndexOf(ClassRef)<0) then FRegisteredProviders.Add(ClassRef); end; function TvfsManager.FindProvider(const StorageName: string): TvfsProviderClass; var i: integer; begin Result:= nil; for i:= FRegisteredProviders.Count-1 downto 0 do if AnsiCompareText(StorageName, TvfsProviderClass(FRegisteredProviders[i]).StorageName)=0 then begin Result:= TvfsProviderClass(FRegisteredProviders[i]); break; end; end; function TvfsManager.GetProvider(const Index: integer): TvfsProviderClass; begin if (Index>=0) and (Index4 then mo:= cols[4] else mo:= ''; tcc:= FindProvider(tp); if Assigned(tcc) then begin tc:= tcc.Create(fs, mo); AddOverlay(ly, mp, tc); end else raise EvfsError.CreateFmt('Unsupported Overlay Provider: "%s"',[tp]); end; finally FreeAndNil(cols); end; finally FreeAndNil(tab); end; end; initialization finalization FreeAndNil(VFSSingleton); end.