|
|
@@ -0,0 +1,978 @@ |
|
|
|
{ |
|
|
|
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; |
|
|
|
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 (Index<FRegisteredProviders.Count) then |
|
|
|
Result:= TvfsProviderClass(FRegisteredProviders[Index]) |
|
|
|
else |
|
|
|
Result:= nil; |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TvfsManager.SaveConfigFile(const Filename: string; PathBase: string); |
|
|
|
var |
|
|
|
tab: TStringList; |
|
|
|
cols: TutlCSVList; |
|
|
|
i: integer; |
|
|
|
o: TvfsOverlay; |
|
|
|
begin |
|
|
|
if PathBase='' then |
|
|
|
PathBase:= ExtractFilePath(Filename); |
|
|
|
PathBase:= IncludeTrailingPathDelimiter(vfsSystemPathDelim(PathBase)); |
|
|
|
tab:= TStringList.Create; |
|
|
|
try |
|
|
|
tab.Add(VFSTAB_COMMENT+'GENERATED FILE; DO NOT EDIT'); |
|
|
|
cols:= TutlCSVList.Create; |
|
|
|
try |
|
|
|
cols.Delimiter:= VFSTAB_SEPARATOR; |
|
|
|
cols.QuoteChar:= VFSTAB_QUOTE; |
|
|
|
|
|
|
|
for i:= 0 to OverlayCount-1 do begin |
|
|
|
o:= Overlay[i]; |
|
|
|
cols.Clear; |
|
|
|
cols.Add(IntToStr(o.Layer)); |
|
|
|
cols.Add(o.Mountpoint); |
|
|
|
cols.Add(o.Provider.StorageName); |
|
|
|
cols.Add(ExtractRelativepath(PathBase,o.Provider.StorageGetFileSpec)); |
|
|
|
cols.Add(o.Provider.StorageGetData); |
|
|
|
tab.Add(cols.StrictDelimitedText); |
|
|
|
end; |
|
|
|
tab.SaveToFile(Filename); |
|
|
|
finally |
|
|
|
FreeAndNil(cols); |
|
|
|
end; |
|
|
|
finally |
|
|
|
FreeAndNil(tab); |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TvfsManager.ApplyConfigFile(const Filename: string; PathBase: string); |
|
|
|
var |
|
|
|
tab: TStringList; |
|
|
|
cols: TutlCSVList; |
|
|
|
l: integer; |
|
|
|
line, s: string; |
|
|
|
ly: TvfsLayer; |
|
|
|
mp,tp,fs,mo: string; |
|
|
|
tc: TvfsProvider; |
|
|
|
tcc: TvfsProviderClass; |
|
|
|
begin |
|
|
|
if PathBase = '' then begin |
|
|
|
s := IncludeTrailingPathDelimiter(GetCurrentDir) + Filename; |
|
|
|
if SysUtils.FileExists(s) then |
|
|
|
PathBase := ExtractFilePath(s) |
|
|
|
else |
|
|
|
PathBase := ExtractFilePath(Filename); |
|
|
|
end; |
|
|
|
PathBase:= IncludeTrailingPathDelimiter(vfsSystemPathDelim(PathBase)); |
|
|
|
tab:= TStringList.Create; |
|
|
|
try |
|
|
|
cols:= TutlCSVList.Create; |
|
|
|
try |
|
|
|
cols.Delimiter:= VFSTAB_SEPARATOR; |
|
|
|
cols.QuoteChar:= VFSTAB_QUOTE; |
|
|
|
cols.SkipDelims:= true; |
|
|
|
tab.LoadFromFile(Filename); |
|
|
|
for l:= 0 to tab.Count - 1 do begin |
|
|
|
line:= trim(tab[l]); |
|
|
|
if (line='') or (line[1]=VFSTAB_COMMENT) then |
|
|
|
continue; |
|
|
|
cols.StrictDelimitedText:= line; |
|
|
|
ly:= StrToInt(cols[0]); |
|
|
|
mp:= cols[1]; |
|
|
|
tp:= cols[2]; |
|
|
|
fs:= vfsExpandFileName(cols[3], PathBase); |
|
|
|
if cols.Count>4 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. |