virtualfilesystem/uvfsFolder.pas

unit uvfsFolder;

interface

uses
  SysUtils, Classes, uvfsManager;

type

  { TvfsFileSystemFolder }

  TvfsFileSystemFolder = class(TvfsProvider)
  private
    FRoot: string;
    function ExpandPath(P:string): string;
    procedure DeleteEmptyDir(aDir: String);
  public
    constructor Create(const FileSpec:string; const ExtendedData: string=''); override;
    class function StorageName: string; override;
    function StorageGetFileSpec: string; override;
    // ACHTUNG: FileInfo.Size wird mit einem Integer gefüllt. Bei Dateien > 2GB aufpassen!
    function GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): Boolean; override;
    function Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean; override;
    function Rename(const OldName, NewName: string): boolean; override;
    function Delete(const aName: String): boolean; override;
    procedure DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean); override;

    function Root: string;
  end;


implementation

{ TvfsFileSystemFolder }

constructor TvfsFileSystemFolder.Create(const FileSpec: string; const ExtendedData: string);
begin
  inherited;
  FRoot:= vfsSystemPathDelim(FileSpec);
end;

class function TvfsFileSystemFolder.StorageName: string;
begin
  Result:= 'folder';
end;

function TvfsFileSystemFolder.StorageGetFileSpec: string;
begin
  Result:= Self.Root;
end;

procedure TvfsFileSystemFolder.DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean);
  procedure FindFiles(sRoot, sPfad: String);
  var
    Rec:TSearchRec;
    s: string;
    a: TvfsDirectoryEntry;
  begin
    if sPfad>'' then
      sPfad:= IncludeTrailingPathDelimiter(sPfad);
    if FindFirst(sRoot+sPfad+'*', faAnyFile,Rec)=0 then
    repeat
      if (Rec.Name<>'.') and (Rec.Name<>'..') then begin
        s:= sPfad+Rec.Name;
        a:= TvfsDirectoryEntry.Create;
        a.FileInfo.Size:= Rec.Size;
        a.FileInfo.Attributes:= Rec.Attr;
        a.FileInfo.ModDate:= FileDateToDateTime(Rec.Time);
        if (Rec.Attr and faDirectory = faDirectory) then begin
          AddFunction(IncludeTrailingPathDelimiter(s), a, List);
          if Subdirs then
            FindFiles(sRoot, s);
        end else
          AddFunction(s, a, List);
      end;
    until FindNext(Rec)<>0;
    Findclose(Rec);
  end;
begin
  FindFiles(IncludeTrailingPathDelimiter(FRoot),Path);
end;

function TvfsFileSystemFolder.ExpandPath(P: string): string;
begin
  Result:= vfsSystemPathDelim(IncludeTrailingPathDelimiter(FRoot)+P);
end;

procedure TvfsFileSystemFolder.DeleteEmptyDir(aDir: String);

  function FileCount(aDir: String): Integer;
  var
    sr: TSearchRec;
    found: Integer;
  begin
    result := 0;
    if (Length(aDir) > 0) and (aDir[Length(aDir)] <> '\') then
      aDir := aDir + '\';
    found := FindFirst(aDir+'*.*', faAnyFile, sr);
    while found = 0 do begin
      if (sr.Name <> '.') and (sr.Name <> '..') then
        inc(result);
      found := FindNext(sr);
    end;
    FindClose(sr);
  end;

begin
  while DirectoryExists(aDir) and (FileCount(aDir) = 0) do begin
    RemoveDir(aDir);
    if (Length(aDir) > 0) and (aDir[Length(aDir)] = '\') then
      System.Delete(aDir, Length(aDir), 1);
    aDir := ExtractFilePath(aDir);
  end;
end;

function TvfsFileSystemFolder.GetFileInfo(const FileName: String; out FileInfo: TvfsFileInfo): Boolean;
var
  sr: TSearchRec;
begin
  Result:= FindFirst(ExpandPath(FileName),faAnyFile, sr) = 0;
  try
    if Result then begin
      FileInfo.Size:= sr.Size;
      FileInfo.Attributes:= sr.Attr;
      FileInfo.ModDate:= FileDateToDateTime(sr.Time);
    end;
  finally
    FindClose(sr);
  end;
end;

function TvfsFileSystemFolder.Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean;
var
  fs: TFileStream;
  mode: word;
begin
  Stream:= nil;
  Result:= false;
  try
    case OpenMode of
      omCreateAlways: mode:= fmCreate;
    else
      begin
        if FileExists(ExpandPath(FileName)) then
          case OpenMode of
            omReadOnly: mode:= fmOpenRead or fmShareDenyWrite;
            omReadWrite,
            omReadWriteCreate: mode:= fmOpenReadWrite;
          end
        else
          case OpenMode of
            omReadOnly,
            omReadWrite: exit;
            omReadWriteCreate: mode:= fmCreate;
          end;
      end;
    end;
    if (mode and fmCreate) > 0 then
      ForceDirectories(ExtractFilePath(ExpandPath(FileName)));
    try
      fs:= TFileStream.Create(ExpandPath(FileName), mode);
    except
      fs := nil;
    end;
    Result:= Assigned(fs);
    if Result then begin
      if OpenMode = omReadOnly then
        Stream:= TvfsStreamHandleRead.Create(fs)
      else
        Stream:= TvfsStreamHandleWrite.Create(fs, nil, nil, 0);
    end;
  except
    FreeAndNil(fs);
    raise;
  end;
end;

function TvfsFileSystemFolder.Rename(const OldName, NewName: string): boolean;
var
  oldFile, newFile: String;
begin
  oldFile := ExpandPath(OldName);
  newFile := ExpandPath(NewName);
  result := ForceDirectories(ExtractFilePath(newFile));
  if result then begin
    Result:= RenameFile(oldFile, newFile);
    DeleteEmptyDir(ExtractFilePath(oldFile));
  end;
end;

function TvfsFileSystemFolder.Delete(const aName: String): boolean;
var
  filename: String;
begin
  filename := ExpandPath(aName);
  result := DeleteFile(filename);
  if not result then
    result := RemoveDir(filename);
  DeleteEmptyDir(ExtractFilePath(filename));
end;

function TvfsFileSystemFolder.Root: string;
begin
  Result:= FRoot;
end;


initialization
  VFSManager.RegisterProvider(TvfsFileSystemFolder);
end.