Fixed XP bug: wrong file matching on network drive. Fix code to work on Wine. Added a few more tests

Tests/VfsControl.pas

@@ -10,7 +10,7 @@ uses
   Windows, SysUtils,
   Utils, WinUtils, TypeWrappers, DataLib,
   Files, StrLib,
-  VfsBase, VfsUtils, VfsHooks, DlgMes;
+  VfsBase, VfsUtils, VfsHooks, DlgMes {FIXME DELETEME};
 
 type
   (* Import *)
@@ -72,68 +72,85 @@ begin
   result := (i > StrLen) and (ModName <> '') and (ModName <> '.') and (ModName <> '..');
 end;
 
-function LoadModList (const ModListFilePath: WideString): {O} DataLib.TList {of (O) TWideString};
+// function LoadModList (const ModListFilePath: WideString; {O} var {out} ModList: DataLib.TList {of (O) TWideString}): boolean;
+// var
+//   AbsFilePath:  WideString;
+//   FileHandle:   integer;
+//   FileContents: string;
+//   Lines:        Utils.TArrayOfStr;
+//   ModNameUtf8:  string;
+//   ModName:      WideString;
+//   i:            integer;
+
+//   // FIXME ModList is not result
+
+// begin
+//   result := DataLib.NewList(Utils.OWNS_ITEMS);
+//   // * * * * * //
+//   AbsFilePath := VfsUtils.NormalizePath(ModListFilePath);
+//   FileHandle  := Windows.CreateFileW(PWideChar(AbsFilePath), Windows.GENERIC_READ, Windows.FILE_SHARE_READ, nil, Windows.OPEN_EXISTING, 0, nil);
+//   // Make available UNICODE path
+//   // Make UTF8 BOM support EF BB BF
+
+//   if (AbsFilePath <> '') and (Files.ReadFileContents(AbsFilePath, FileContents)) then begin
+//     Lines := StrLib.Explode(FileContents, #10);
+
+//     for i := 0 to High(Lines) do begin
+//       ModNameUtf8 := Lines[i];
+//       ModName     := StrLib.TrimW(StrLib.Utf8ToWide(ModNameUtf8, StrLib.FAIL_ON_ERROR));
+
+//       if ValidateModName(ModName) then begin
+//         result.Add(TWideString.Create(ModName));
+//       end;
+//     end;
+//   end;
+// end; // .function LoadModList
+
+function MapModsFromList_ (const RootDir, ModsDir: WideString; ModList: TList {of (O) TWideString}; Flags: integer = 0): boolean;
 var
-  AbsFilePath:  WideString;
+  AbsRootDir:        WideString;
-  FileContents: string;
+  AbsModsDir:        WideString;
-  Lines:        Utils.TArrayOfStr;
+  FileInfo:          VfsUtils.TNativeFileInfo;
-  ModNameUtf8:  string;
   ModName:           WideString;
+  ModPathPrefix:     WideString;
+  NumFailedMappings: integer;
   i:                 integer;
 
 begin
-  result := DataLib.NewList(Utils.OWNS_ITEMS);
+  {!} Assert(ModList <> nil);
   // * * * * * //
-  AbsFilePath := VfsUtils.NormalizePath(ModListFilePath);
+  AbsRootDir := VfsUtils.NormalizePath(RootDir);
+  AbsModsDir := VfsUtils.NormalizePath(ModsDir);
+  result     := (AbsRootDir <> '') and (AbsModsDir <> '') and VfsUtils.GetFileInfo(AbsRootDir, FileInfo);
+  result     := result and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes);
+  result     := result and VfsUtils.GetFileInfo(AbsModsDir, FileInfo);
+  result     := result and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes);
   
-  if (AbsFilePath <> '') and (Files.ReadFileContents(AbsFilePath, FileContents)) then begin
+  if result then begin
-    Lines := StrLib.Explode(FileContents, #10);
+    ModPathPrefix     := VfsUtils.AddBackslash(AbsModsDir);
+    NumFailedMappings := 0;
 
-    for i := 0 to High(Lines) do begin
+    for i := ModList.Count - 1 downto 0 do begin
-      ModNameUtf8 := Lines[i];
+      ModName := TWideString(ModList[i]).Value;
-      ModName     := StrLib.Utf8ToWide(ModNameUtf8);
 
-      if ValidateModName(ModName) then begin
+      if not VfsBase.MapDir(AbsRootDir, ModPathPrefix + ModName, not VfsBase.OVERWRITE_EXISTING, Flags) then begin
-        result.Add(TWideString.Create(ModName));
+        Inc(NumFailedMappings);
       end;
     end;
+
+    result := (NumFailedMappings = 0) or (NumFailedMappings < ModList.Count);
+  end; // .if
+end; // .function MapModsFromList
+
+function MapModsFromList (const RootDir, ModsDir, ModListFile: WideString; Flags: integer = 0): boolean;
+begin
+  
 end;
-end; // .function LoadModList
-
-// function MapModsDir (const RootDir, ModsDir: WideString; Flags: integer = 0);
-// var
-//   AbsRootDir: WideString;
-//   AbsModsDir: WideString;
-//   FileInfo:   VfsUtils.TNativeFileInfo;
-//   ModName:    WideString;
-
-
-// begin
-//   AbsRootDir := VfsUtils.NormalizePath(RootDir);
-//   AbsModsDir := VfsUtils.NormalizePath(ModsDir);
-//   result     := (AbsRootDir <> '') and (AbsModsDir <> '') and VfsUtils.GetFileInfo(AbsRootDir, FileInfo);
-//   result     := result and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes);
-//   result     := result and VfsUtils.GetFileInfo(AbsModsDir, FileInfo);
-//   result     := result and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes);
-  
-//   if result then begin
-//     with VfsUtils.SysScanDir(AbsModsDir, '*') do begin
-//       while IterNext(ModName, @FileInfo.Base) do begin
-//         if (ModName <> '.') and (ModName <> '..') and Utils.HasFlag(Windows.FILE_ATTRIBUTE_DIRECTORY, FileInfo.Base.FileAttributes) then begin
-          
-//         end;
-//       end;
-//     end;
-//   end;
-// end;
 
 var
 L: TList;
 i: integer;
 
 begin
-  // L := LoadModList('D:\Heroes 3\Mods\list.txt');
+
-  // for i := 0 to L.Count- 1 do begin
-  //   VarDump([TWideString(L[i]).Value]);
-  // end;
 end.

Tests/VfsIntegratedTest.pas

@@ -61,7 +61,7 @@ end;
 procedure TestIntegrated.TearDown;
 begin
   VfsBase.ResetVfs();
-  //VfsDebug.SetLoggingProc(nil);
+  VfsDebug.SetLoggingProc(nil);
 end;
 
 procedure TestIntegrated.TestGetFileAttributes;
@@ -143,6 +143,7 @@ begin
   try
     VfsDebug.WriteLog('TestFilesOpenClose', 'Started');
     Check(WinUtils.SetCurrentDirW(RootDir), 'Setting current directory to real path must succeed. Path: ' + RootDir);
+    CheckEquals(RootDir, WinUtils.GetCurrentDirW(), 'GetCurrentDirW must return virtual path, not redirected one');
     
     Check(OpenFile(VfsUtils.MakePath([RootDir, 'non-existing.non'])) <= 0, 'Opening non-existing file must fail');
 

VfsBase.pas

@@ -194,6 +194,21 @@ begin
   VfsCritSection.Leave;
 end;
 
+function EnterVfsConfig: boolean;
+begin
+  VfsCritSection.Enter;
+  result := not VfsIsRunning and not VfsTreeIsBuilt;
+
+  if not result then begin
+    VfsCritSection.Leave;
+  end;
+end;
+
+procedure LeaveVfsConfig;
+begin
+  VfsCritSection.Leave;
+end;
+
 function CompareVfsItemsByPriorityDescAndNameAsc (Item1, Item2: integer): integer;
 begin
   result := TVfsItem(Item2).Priority - TVfsItem(Item1).Priority;
@@ -525,16 +540,11 @@ end; // .function _MapDir
 
 function MapDir (const VirtPath, RealPath: WideString; OverwriteExisting: boolean; Flags: integer = 0): boolean;
 begin
-  with VfsCritSection do begin
+  result := EnterVfsConfig;
-    Enter;
-    
-    result := not VfsIsRunning and not VfsTreeIsBuilt;
 
   if result then begin
     result := _MapDir(NormalizePath(VirtPath), NormalizePath(RealPath), nil, OverwriteExisting, AUTO_PRIORITY) <> nil;
-    end;
+    LeaveVfsConfig;
-    
-    Leave;
   end;
 end;
 

VfsHooks.pas

@@ -86,6 +86,7 @@ var
   ExpandedPath:      WideString;
   RedirectedPath:    WideString;
   ReplacedObjAttrs:  WinNative.TObjectAttributes;
+  ReplacedPath:      WinNative.UNICODE_STRING;
   FileInfo:          TNativeFileInfo;
   HadTrailingDelim_: array [0..3] of byte; // Fix Delphi bug: HadTrailingDelim causes stack 4-bytes misalignment
   HadTrailingDelim:  boolean absolute HadTrailingDelim_;
@@ -128,6 +129,7 @@ begin
 
       ReplacedObjAttrs.RootDirectory := 0;
       ReplacedObjAttrs.Attributes    := ReplacedObjAttrs.Attributes or WinNative.OBJ_CASE_INSENSITIVE;
+      ReplacedObjAttrs.ObjectName    := @ReplacedPath;
       ReplacedObjAttrs.ObjectName.AssignExistingStr(RedirectedPath);
     end;
     
@@ -144,6 +146,7 @@ var
   ExpandedPath:      WideString;
   RedirectedPath:    WideString;
   ReplacedObjAttrs:  WinNative.TObjectAttributes;
+  ReplacedPath:      WinNative.UNICODE_STRING;
   FileInfo:          TNativeFileInfo;
   HadTrailingDelim_: array [0..3] of byte; // Fix Delphi bug: HadTrailingDelim causes stack 4-bytes misalignment
   HadTrailingDelim:  boolean absolute HadTrailingDelim_;
@@ -189,6 +192,7 @@ begin
 
       ReplacedObjAttrs.RootDirectory := 0;
       ReplacedObjAttrs.Attributes    := ReplacedObjAttrs.Attributes or WinNative.OBJ_CASE_INSENSITIVE;
+      ReplacedObjAttrs.ObjectName    := @ReplacedPath;
       ReplacedObjAttrs.ObjectName.AssignExistingStr(RedirectedPath);
     end;
     
@@ -216,6 +220,7 @@ var
   ExpandedPath:      WideString;
   RedirectedPath:    WideString;
   ReplacedObjAttrs:  WinNative.TObjectAttributes;
+  ReplacedPath:      WinNative.UNICODE_STRING;
   HadTrailingDelim_: array [0..3] of byte; // Fix Delphi bug: HadTrailingDelim causes stack 4-bytes misalignment
   HadTrailingDelim:  boolean absolute HadTrailingDelim_;
 
@@ -246,6 +251,7 @@ begin
 
     ReplacedObjAttrs.RootDirectory := 0;
     ReplacedObjAttrs.Attributes    := ReplacedObjAttrs.Attributes or WinNative.OBJ_CASE_INSENSITIVE;
+    ReplacedObjAttrs.ObjectName    := @ReplacedPath;
     ReplacedObjAttrs.ObjectName.AssignExistingStr(RedirectedPath);
   end;
 

VfsOpenFiles.pas

@@ -108,9 +108,13 @@ begin
 
   with VfsBase.GetThreadVfsDisabler do begin
     DisableVfsForThread;
+
+    try
       VfsUtils.GetDirectoryListing(Self.AbsPath, Mask, ExcludedItems, Self.DirListing);
+    finally
       RestoreVfsForThread;
     end;
+  end;
 
   // No real items added, maybe there is a need to add '.' and/or '..' manually
   if VfsItemFound and (Self.DirListing.Count = NumVfsChildren) then begin

VfsUtils.pas

@@ -8,8 +8,9 @@ unit VfsUtils;
 
 uses
   SysUtils, Math, Windows,
-  Utils, WinNative, Alg, TypeWrappers, Lists, DataLib,
+  Utils, WinNative, Alg, TypeWrappers,
-  StrLib;
+  Lists, DataLib, StrLib,
+  VfsMatching;
 
 type
   (* Import *)
@@ -146,7 +147,9 @@ function SysScanDir (const hDir: Windows.THandle; const Mask: WideString): ISysD
 function SysScanDir (const DirPath, Mask: WideString): ISysDirScanner; overload;
 
 (* Scans specified directory and adds sorted entries to directory listing. Optionally exclude names from Exclude dictionary.
-   Excluded items must be preprocessed via WideStringToCaselessKey routine *)
+   Excluded items must be preprocessed via WideStringToCaselessKey routine.
+   Applies filtering by mask to fix possible invalid native functions behavior, found at least on Win XP when
+   tests were run on network drive *)
 procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing);
 
 (***)  implementation  (***)
@@ -636,17 +639,18 @@ procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Excl
 var
 {O} Items:        {O} TList {OF TDirListingItem};
 {O} Item:         {O} TDirListingItem;
+    CompiledMask: Utils.TArrayOfByte;
     i:            integer;
 
 begin
   {!} Assert(DirListing <> nil);
-  // * * * * * //
   Items        := DataLib.NewList(Utils.OWNS_ITEMS);
   Item         := TDirListingItem.Create;
+  CompiledMask := VfsMatching.CompilePattern(FileMask);
   // * * * * * //
   with VfsUtils.SysScanDir(SearchPath, FileMask) do begin
     while IterNext(Item.Info.FileName, @Item.Info.Base) do begin     
-      if (Exclude = nil) or (Exclude[WideStrToCaselessKey(Item.Info.FileName)] = nil) then begin
+      if VfsMatching.MatchPattern(Item.Info.FileName, pointer(CompiledMask)) and ((Exclude = nil) or (Exclude[WideStrToCaselessKey(Item.Info.FileName)] = nil)) then begin
         Item.SearchName := StrLib.WideLowerCase(Item.Info.FileName);
         Items.Add(Item); Item := nil;
         Item := TDirListingItem.Create;