Fixed bug: MapDir on non-existent directories reported TRUE. Improved generated mappings report

VfsBase.pas

@@ -126,6 +126,10 @@ function MapDir (const VirtPath, RealPath: WideString; OverwriteExisting: boolea
 (* Calls specified function with a single argument and returns its result. VFS is disabled for current thread during function exection *)
 function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): integer; stdcall;
 
+(* Returns text with all applied mappings, separated via #13#10. If ShortenPaths is true, common part
+   of real and virtual paths is stripped *)
+function GetMappingsReport: WideString;
+
 
 (***)  implementation  (***)
 
@@ -133,12 +137,13 @@ function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): inte
 type
   (* Applied and remembered mapping. Used to refresh or report VFS *)
   TMapping = class
+    Applied:           LONGBOOL;
     AbsVirtPath:       WideString;
     AbsRealPath:       WideString;
-    OverwriteExisting: boolean;
+    OverwriteExisting: LONGBOOL;
     Flags:             integer;
 
-    class function Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): TMapping;
+    class function Make (Applied: boolean; const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): TMapping;
   end;
 
 var
@@ -332,9 +337,10 @@ begin
   end;
 end; // .procedure BuildVfsItemsTree
 
-class function TMapping.Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): {O} TMapping;
+class function TMapping.Make (Applied: boolean; const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): {O} TMapping;
 begin
   result                   := TMapping.Create;
+  result.Applied           := Applied;
   result.AbsVirtPath       := AbsVirtPath;
   result.AbsRealPath       := AbsRealPath;
   result.OverwriteExisting := OverwriteExisting;
@@ -468,7 +474,8 @@ begin
   Dest.EaSize         := Src.EaSize;
 end;
 
-(* Redirects single file/directory path (not including directory contents). Target must exist for success *)
+(* Redirects single file/directory path (not including directory contents). Returns redirected VFS item
+   for given real path if VFS item was successfully created/overwritten or it already existed and OverwriteExisting = false. *)
 function RedirectFile (const AbsVirtPath, AbsRealPath: WideString; {n} FileInfoPtr: WinNative.PFILE_ID_BOTH_DIR_INFORMATION; OverwriteExisting: boolean; Priority: integer): {Un} TVfsItem;
 const
   WIDE_NULL_CHAR_LEN = Length(#0);
@@ -550,7 +557,7 @@ begin
   end;
   
   DirVfsItem := RedirectFile(AbsVirtPath, AbsRealPath, FileInfoPtr, OverwriteExisting, Priority);
-  Success    := DirVfsItem <> nil;
+  Success    := (DirVfsItem <> nil) and ((DirVfsItem.RealPath = AbsRealPath) or VfsUtils.IsDir(AbsRealPath));
 
   if Success then begin
     VirtPathPrefix := AddBackslash(AbsVirtPath);
@@ -599,8 +606,8 @@ begin
     result      := (AbsVirtPath <> '') and (AbsRealPath <> '');
 
     if result then begin
-      Mappings.Add(TMapping.Make(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags));
       result := _MapDir(AbsVirtPath, AbsRealPath, nil, OverwriteExisting, Flags, AUTO_PRIORITY) <> nil;
+      Mappings.Add(TMapping.Make(result, AbsVirtPath, AbsRealPath, OverwriteExisting, Flags));
     end;
 
     LeaveVfsConfig;
@@ -638,7 +645,7 @@ begin
 
       for i := 0 to Mappings.Count - 1 do begin
         with TMapping(Mappings[i]) do begin
-          MapDir(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags);
+          TMapping(Mappings[i]).Applied := MapDir(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags);
         end;
       end;
 
@@ -686,6 +693,126 @@ begin
   end; // .with
 end; // .function RefreshMappedFile
 
+function GetMappingsReport: WideString;
+const
+  COL_PATHS = 0;
+  COL_META  = 1;
+
+var
+{O} Buf:             StrLib.TStrBuilder;
+{O} Line:            StrLib.TStrBuilder;
+    Cols:            array [0..1] of array of WideString;
+    MaxPathColWidth: integer;
+    i:               integer;
+
+  procedure WriteMapping (Mapping: TMapping; LineN: integer);
+  var
+    StartPathPos:     integer;
+    MaxCommonPathLen: integer;
+    ShortestPath:     WideString;
+    LongestPath:      WideString;
+    i:                integer;
+
+  begin
+    {!} Assert(Mapping <> nil);
+    StartPathPos := 1;
+
+    if Length(Mapping.AbsRealPath) > Length(Mapping.AbsVirtPath) then begin
+      LongestPath  := Mapping.AbsRealPath;
+      ShortestPath := Mapping.AbsVirtPath;
+    end else begin
+      LongestPath  := Mapping.AbsVirtPath;
+      ShortestPath := Mapping.AbsRealPath;
+    end;
+
+    i                := 1;
+    MaxCommonPathLen := Length(ShortestPath);
+
+    while (i <= MaxCommonPathLen) and (ShortestPath[i] = LongestPath[i]) do begin
+      Inc(i);
+    end;
+
+    // Handle case: [xxx\yyy] zzz and [xxx\yyy]. Common part is [xxx]
+    if (Length(LongestPath) > MaxCommonPathLen) and (LongestPath[i] <> '\') then begin
+      while (i >= 2) and (LongestPath[i] <> '\') do begin
+        Dec(i);
+      end;
+    end
+    // Handle case: D:\App <= D:\Mods. Common part is D:
+    else if ShortestPath[i] = '\' then begin
+      Dec(i);
+    end;
+
+    StartPathPos := i;
+    Line.Clear;
+
+    if StartPathPos > 1 then begin
+      Line.AppendWide('$');
+    end;
+
+    Line.AppendWide(Copy(Mapping.AbsVirtPath, StartPathPos));
+    Line.AppendWide(' <= ');
+
+    if StartPathPos > 1 then begin
+      Line.AppendWide('$');
+    end;
+
+    Line.AppendWide(Copy(Mapping.AbsRealPath, StartPathPos));
+    
+    if not Mapping.Applied then begin
+      Line.AppendWide(' *MISS*');
+    end;
+
+    Cols[COL_PATHS][LineN] := Line.BuildWideStr;
+    MaxPathColWidth        := Max(MaxPathColWidth, Length(Cols[COL_PATHS][LineN]));
+
+    Line.Clear;
+    Line.AppendWide('[Overwrite = ' + IntToStr(ord(Mapping.OverwriteExisting)) + ', Flags = ' + IntToStr(Mapping.Flags));
+
+    if StartPathPos > 1 then begin
+      Line.AppendWide(', $ = "' + Copy(ShortestPath, 1, StartPathPos - 1) + '"]');
+    end else begin
+      Line.AppendWide(']');
+    end;
+
+    Cols[COL_META][LineN] := Line.BuildWideStr;
+  end; // .procedure WriteMapping
+
+  function FormatResultTable: WideString;
+  var
+    i: integer;
+
+  begin
+    for i := 0 to Mappings.Count - 1 do begin
+      Buf.AppendWide(Cols[COL_PATHS][i] + StringOfChar(WideChar(' '), MaxPathColWidth - Length(Cols[COL_PATHS][i]) + 1));
+      Buf.AppendWide(Cols[COL_META][i]);
+      
+      if i < Mappings.Count - 1 then begin
+        Buf.AppendWide(#13#10);
+      end;
+    end;
+
+    result := Buf.BuildWideStr;
+  end;
+
+begin
+  Buf  := StrLib.TStrBuilder.Create;
+  Line := StrLib.TStrBuilder.Create;
+  // * * * * * //
+  SetLength(Cols[COL_PATHS], Mappings.Count);
+  SetLength(Cols[COL_META],  Mappings.Count);
+  MaxPathColWidth := 0;
+
+  for i := 0 to Mappings.Count - 1 do begin
+    WriteMapping(TMapping(Mappings[i]), i);
+  end;
+
+  result := FormatResultTable;
+  // * * * * * //
+  SysUtils.FreeAndNil(Buf);
+  SysUtils.FreeAndNil(Line);
+end; // .function GetMappingsReport
+
 begin
   VfsCritSection.Init;
   VfsItems    := DataLib.NewDict(Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);

VfsExport.pas

@@ -8,6 +8,7 @@ unit VfsExport;
 
 uses
   Windows,
+  Utils,
   VfsDebug, VfsBase, VfsControl, VfsWatching;
 
 exports
@@ -48,6 +49,36 @@ begin
   result := VfsWatching.RunWatcher(WatchDir, DebounceInterval);
 end;
 
+(* Frees buffer, that was transfered to client earlier using other VFS API *)
+procedure MemFree ({O} Buf: pointer); stdcall;
+begin
+  FreeMem(Buf);
+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);
+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);
+end;
+
 procedure ConsoleLoggingProc (Operation, Message: pchar); stdcall;
 begin
   WriteLn('>> ', string(Operation), ': ', string(Message), #13#10);
@@ -88,6 +119,9 @@ exports
   MapModsFromList,
   MapModsFromListA,
   RunWatcher,
+  GetMappingsReport,
+  GetMappingsReportA,
+  MemFree,
   InstallConsoleLogger;
 
 end.

VfsImport.pas

@@ -33,9 +33,18 @@ function RunVfs (DirListingOrder: TDirListingSortType): LONGBOOL; stdcall; exter
    time in msec to wait after last change before running full VFS rescanning routine *)
 function RunWatcher (const WatchDir: PWideChar; DebounceInterval: integer): LONGBOOL; stdcall; external 'vfs.dll';
 
+(* Frees buffer, that was transfered to client earlier using other VFS API *)
+procedure MemFree ({O} Buf: pointer); stdcall; external 'vfs.dll';
+
+(* 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; external 'vfs.dll';
+function GetMappingsReportA: {O} pchar; stdcall; external 'vfs.dll';
+
 (* Allocates console and install logger, writing messages to console *)
 procedure InstallConsoleLogger; stdcall; external 'vfs.dll';
 
+
 (***)  implementation  (***)
 
 

VfsUtils.pas

@@ -140,6 +140,12 @@ function StripNtAbsPathPrefix (const Path: WideString): WideString;
 (* Saves API result in external variable and returns result as is *)
 function SaveAndRet (Res: integer; out ResCopy): integer;
 
+(* Returns attributes for file at given path *)
+function GetFileAttrs (const Path: WideString; {out} var Attrs: integer): boolean;
+
+(* Returns true if directory with given path exists *)
+function IsDir (const Path: WideString): boolean;
+
 (* Opens file/directory using absolute NT path and returns success flag *)
 function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = FILE_GENERIC_READ): boolean;
 
@@ -155,6 +161,7 @@ function SysScanDir (const DirPath, Mask: WideString): ISysDirScanner; overload;
    tests were run on network drive *)
 procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing);
 
+
 (***)  implementation  (***)
 
 
@@ -478,6 +485,30 @@ begin
   result := StrLib.Join(FileNames, #13#10);
 end;
 
+function GetFileAttrs (const Path: WideString; {out} var Attrs: integer): boolean;
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+
+var
+  Res: integer;
+
+begin
+  Res    := integer(Windows.GetFileAttributesW(PWideChar(Path)));
+  result := Res <> INVALID_FILE_ATTRIBUTES;
+
+  if result then begin
+    Attrs := Res;
+  end;
+end;
+
+function IsDir (const Path: WideString): boolean;
+var
+  FileAttrs: integer;
+
+begin
+  result := GetFileAttrs(Path, FileAttrs) and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileAttrs);
+end;
+
 function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = FILE_GENERIC_READ): boolean;
 var
   FilePathU:     WinNative.UNICODE_STRING;
@@ -521,7 +552,7 @@ begin
 
   if IsNtRootDriveAbsPath(NtAbsPath) then begin
     // Return fake info for root drive
-    result := SaveAndRet(Windows.GetFileAttributesW(PWideChar(StripNtAbsPathPrefix(NtAbsPath))), FileAllInfo.BasicInformation.FileAttributes) <> integer(Windows.INVALID_HANDLE_VALUE);
+    result := GetFileAttrs(StripNtAbsPathPrefix(NtAbsPath), integer(FileAllInfo.BasicInformation.FileAttributes));
 
     if result then begin
       FillChar(Res.Base, sizeof(Res.Base), 0);