|
- 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.
|