git_admin/Virtual-File-System
1
0
Fork 0
mirror of https://github.com/CloudDelphi/Virtual-File-System synced 2025-12-19 09:53:54 +01:00
Code Issues Packages Projects Releases Wiki Activity

Fixed bug: invalid HasFlag usage lead to non-mapping directories in MapDir. Added GetDetailedMappingReport API. VfsItems now hold VirtAddr in addition to RealAddr

Browse Source
This commit is contained in:
Berserker 2019-05-28 17:46:01 +03:00
parent 2c4004dc5a
commit 76700b64e8
5 changed files with 101 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Vfs.dproj
View File

@ -30,7 +30,11 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">True</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">1</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1049</VersionInfo><VersionInfo Name="CodePage">1251</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">Alexander Shostak (aka EtherniDee)</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Virtual File System</VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.1.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">Vfs.dpr</Source></Source><Excluded_Packages>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">True</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">2</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1049</VersionInfo><VersionInfo Name="CodePage">1251</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">Alexander Shostak (aka EtherniDee)</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Virtual File System</VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.2.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">Vfs.dpr</Source></Source><Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>

BIN
Vfs.res
View File

Binary file not shown.

58
VfsBase.pas
View File

@ -48,6 +48,9 @@ type
(* Name in lower case, used for wildcard mask matching *)
SearchName: WideString;
(* Absolute path to virtual file/folder location without trailing slash for non-drives *)
VirtPath: WideString;
(* Absolute path to real file/folder location without trailing slash for non-drives *)
RealPath: WideString;
@ -130,6 +133,10 @@ function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): inte
of real and virtual paths is stripped *)
function GetMappingsReport: WideString;
(* Returns text with all applied mappings on per-file level, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped *)
function GetDetailedMappingsReport: WideString;
(***) implementation (***)
@ -517,6 +524,7 @@ begin
CopyFileInfoWithoutNames(FileInfo.Base, VfsItem.Info.Base);
end;
VfsItem.VirtPath := AbsVirtPath;
VfsItem.RealPath := AbsRealPath;
VfsItem.Priority := Priority;
VfsItem.Attrs := 0;
@ -569,7 +577,7 @@ begin
with SysScanDir(AbsRealPath, '*') do begin
while IterNext(FileInfo.FileName, @FileInfo.Base) do begin
if Utils.HasFlag(FileInfo.Base.FileAttributes, Windows.FILE_ATTRIBUTE_DIRECTORY) then begin
if Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes) then begin
if (FileInfo.FileName <> '.') and (FileInfo.FileName <> '..') then begin
Subdirs.Add(TFileInfo.Create(@FileInfo));
end;
@ -693,7 +701,7 @@ begin
end; // .with
end; // .function RefreshMappedFile
function GetMappingsReport: WideString;
function GetMappingsReport_ (Mappings: TList {of TMapping}): WideString;
const
COL_PATHS = 0;
COL_META = 1;
@ -811,7 +819,51 @@ begin
// * * * * * //
SysUtils.FreeAndNil(Buf);
SysUtils.FreeAndNil(Line);
end; // .function GetMappingsReport
end; // .function GetMappingsReport_
function GetMappingsReport: WideString;
begin
with VfsCritSection do begin
Enter;
result := GetMappingsReport_(Mappings);
Leave;
end;
end;
function CompareMappingsByRealPath (A, B: integer): integer;
begin
result := StrLib.CompareBinStringsW(TMapping(A).AbsRealPath, TMapping(B).AbsRealPath);
end;
function GetDetailedMappingsReport: WideString;
var
{O} DetailedMappings: {O} TList {of TMapping};
{Un} VfsItem: TVfsItem;
begin
DetailedMappings := DataLib.NewList(Utils.OWNS_ITEMS);
VfsItem := nil;
// * * * * * //
with VfsCritSection do begin
Enter;
with DataLib.IterateDict(VfsItems) do begin
while IterNext do begin
VfsItem := TVfsItem(IterValue);
// Note, item Attrs is not the same as directory mapping Flags
DetailedMappings.Add(TMapping.Make(true, VfsItem.VirtPath, VfsItem.RealPath, false, VfsItem.Attrs));
end;
end;
Leave;
end;
DetailedMappings.CustomSort(CompareMappingsByRealPath);
result := GetMappingsReport_(DetailedMappings);
// * * * * * //
SysUtils.FreeAndNil(DetailedMappings);
end;
begin
VfsCritSection.Init;

50
VfsExport.pas
View File

@ -24,6 +24,26 @@ exports
(***) implementation (***)
function Externalize (const Str: AnsiString): {O} pointer; overload;
begin
result := nil;
if Str <> '' then begin
GetMem(result, Length(Str) + 1);
Utils.CopyMem(Length(Str) + 1, pointer(Str), result);
end;
end;
function Externalize (const Str: WideString): {O} pointer; overload;
begin
result := nil;
if Str <> '' then begin
GetMem(result, (Length(Str) + 1) * sizeof(WideChar));
Utils.CopyMem((Length(Str) + 1) * sizeof(WideChar), pointer(Str), result);
end;
end;
function MapDir (const VirtPath, RealPath: PWideChar; OverwriteExisting: boolean; Flags: integer = 0): LONGBOOL; stdcall;
begin
result := VfsBase.MapDir(WideString(VirtPath), WideString(RealPath), OverwriteExisting, Flags);
@ -63,25 +83,25 @@ end;
(* Returns text with all applied mappings, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped. Call MemFree to release result buffer *)
function GetMappingsReport: {O} PWideChar; stdcall;
var
Res: WideString;
begin
result := nil;
Res := VfsBase.GetMappingsReport;
GetMem(result, (Length(Res) + 1) * sizeof(WideChar));
Utils.CopyMem((Length(Res) + 1) * sizeof(WideChar), PWideChar(Res), result);
result := Externalize(VfsBase.GetMappingsReport);
end;
function GetMappingsReportA: {O} pchar; stdcall;
var
Res: string;
begin
result := nil;
Res := VfsBase.GetMappingsReport;
GetMem(result, Length(Res) + 1);
Utils.CopyMem(Length(Res) + 1, pchar(Res), result);
result := Externalize(AnsiString(VfsBase.GetMappingsReport));
end;
(* Returns text with all applied mappings on per-file level, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped *)
function GetDetailedMappingsReport: {O} PWideChar; stdcall;
begin
result := Externalize(VfsBase.GetDetailedMappingsReport);
end;
function GetDetailedMappingsReportA: {O} pchar; stdcall;
begin
result := Externalize(AnsiString(VfsBase.GetDetailedMappingsReport));
end;
procedure ConsoleLoggingProc (Operation, Message: pchar); stdcall;
@ -127,6 +147,8 @@ exports
RunWatcherA,
GetMappingsReport,
GetMappingsReportA,
GetDetailedMappingsReport,
GetDetailedMappingsReportA,
MemFree,
InstallConsoleLogger;

5
VfsImport.pas
View File

@ -51,6 +51,11 @@ procedure MemFree ({O} Buf: pointer); stdcall; external 'vfs.dll';
function GetMappingsReport: {O} PWideChar; stdcall; external 'vfs.dll';
function GetMappingsReportA: {O} pchar; stdcall; external 'vfs.dll';
(* Returns text with all applied mappings on per-file level, separated via #13#10. If ShortenPaths is true, common part
of real and virtual paths is stripped *)
function GetDetailedMappingsReport: {O} PWideChar; stdcall; external 'vfs.dll';
function GetDetailedMappingsReportA: {O} pchar; stdcall; external 'vfs.dll';
(* Allocates console and install logger, writing messages to console *)
procedure InstallConsoleLogger; stdcall; external 'vfs.dll';