Many improvements. Fully working tests. Implemented NT file matching engine

Tests/VfsDebugTest.pas

@@ -52,17 +52,30 @@ begin
 end;
 
 procedure TestDebug.TestLogging;
-begin
+var
-  ClearLog;
+  PrevLoggingProc: VfsDebug.TLoggingProc;
-  VfsDebug.SetLoggingProc(@WriteLog);
-  VfsDebug.WriteLog('TestOperation', 'TestMessage');
-  Check(GetLog() = 'TestOperation;TestMessage', 'Custom logging proc should have written certain message to log');
 
-  ClearLog;
+begin
-  VfsDebug.SetLoggingProc(nil);
+  PrevLoggingProc := Ptr(1);
-  VfsDebug.WriteLog('TestOperation', 'TestMessage');
+  // * * * * * //
-  Check(GetLog() = '', 'Nil logging proc must not write anything to log');
+  try
-end;
+    ClearLog;
+    PrevLoggingProc := VfsDebug.SetLoggingProc(@WriteLog);
+    VfsDebug.WriteLog('TestOperation', 'TestMessage');
+    Check(GetLog() = 'TestOperation;TestMessage', 'Custom logging proc should have written certain message to log');
+    VfsDebug.SetLoggingProc(PrevLoggingProc);
+
+    ClearLog;
+    VfsDebug.SetLoggingProc(nil);
+    VfsDebug.WriteLog('TestOperation', 'TestMessage');
+    Check(GetLog() = '', 'Nil logging proc must not write anything to log');
+    VfsDebug.SetLoggingProc(PrevLoggingProc);
+  finally
+    if @PrevLoggingProc <> Ptr(1) then begin
+      VfsDebug.SetLoggingProc(PrevLoggingProc);
+    end;
+  end; // .try
+end; // .procedure TestDebug.TestLogging
 
 begin
   RegisterTest(TestDebug.Suite);

Tests/VfsIntegratedTest.pas

@@ -4,15 +4,14 @@ unit VfsIntegratedTest;
 
 uses
   SysUtils, TestFramework, Windows,
-  Utils, WinUtils, ConsoleApi, Files,
+  Utils, WinUtils, ConsoleApi, Files, FilesEx,
+  DataLib,
   VfsUtils, VfsBase, VfsDebug,
   VfsOpenFiles, VfsControl, DlgMes;
 
 type
   TestIntegrated = class (TTestCase)
    private
-    Inited: boolean;
-
     function GetRootDir: string;
 
    protected
@@ -23,6 +22,7 @@ type
     procedure TestGetFileAttributes;
     procedure TestGetFileAttributesEx;
     procedure TestFilesOpenClose;
+    procedure TestDirectoryListing;
   end;
 
 
@@ -164,6 +164,83 @@ begin
   end; // .try
 end; // .procedure TestIntegrated.TestFilesOpenClose;
 
+procedure TestIntegrated.TestDirectoryListing;
+const
+  VALID_ROOT_DIR_LISTING          = 'Hobbots'#13#10'vcredist.bmp'#13#10'eula.1028.txt'#13#10'503.html'#13#10'.'#13#10'..'#13#10'default'#13#10'Mods';
+  VALID_ROOT_DIR_MASKED_LISTING_1 = 'vcredist.bmp'#13#10'eula.1028.txt'#13#10'503.html';
+  VALID_ROOT_DIR_MASKED_LISTING_2 = 'eula.1028.txt';
+
+var
+{O} FileList:    {U} DataLib.TStrList;
+{O} DirListing:  VfsUtils.TDirListing;
+    CurrDir:     string;
+    RootDir:     string;
+    DirContents: string;
+
+  function GetDirListing (const Path: string): {O} DataLib.TStrList;
+  var
+    FoundData:    TWin32FindDataA;
+    SearchHandle: Windows.THandle;
+
+  begin
+    result := DataLib.NewStrList(not Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);
+    // * * * * * //
+    SearchHandle := Windows.FindFirstFileA(pchar(Path), FoundData);
+    
+    if SearchHandle <> Windows.INVALID_HANDLE_VALUE then begin
+      result.Add(pchar(@FoundData.cFileName));
+
+      while Windows.FindNextFileA(SearchHandle, FoundData) do begin
+        result.Add(pchar(@FoundData.cFileName));
+      end;
+
+      Windows.FindClose(SearchHandle);
+    end;
+  end; // .function GetDirListing
+
+  function GetDirListingLow (const Path, Mask: WideString): {O} DataLib.TStrList;
+  var
+    FileName: WideString;
+
+  begin
+    result := DataLib.NewStrList(not Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);
+    // * * * * * //
+    with VfsUtils.SysScanDir(Path, Mask) do begin
+      while IterNext(FileName) do begin
+        result.Add(FileName);
+      end;
+    end;
+  end; // .function GetDirListingLow
+
+begin
+  FileList   := nil;
+  DirListing := VfsUtils.TDirListing.Create;
+  // * * * * * //
+  CurrDir := SysUtils.GetCurrentDir;
+  RootDir := Self.GetRootDir;
+
+  try
+    FileList    := GetDirListing(RootDir + '\*');
+    DirContents := FileList.ToText(#13#10);
+    CheckEquals(VALID_ROOT_DIR_LISTING, DirContents);
+    SysUtils.FreeAndNil(FileList);
+
+    FileList    := GetDirListingLow(RootDir, '*.??*');
+    DirContents := FileList.ToText(#13#10);
+    CheckEquals(VALID_ROOT_DIR_MASKED_LISTING_1, DirContents);
+    SysUtils.FreeAndNil(FileList);
+    
+    FileList    := GetDirListing(RootDir + '\*.txt');
+    DirContents := FileList.ToText(#13#10);
+    CheckEquals(VALID_ROOT_DIR_MASKED_LISTING_2, DirContents);
+    SysUtils.FreeAndNil(FileList);
+  finally
+    SysUtils.SetCurrentDir(CurrDir);
+    SysUtils.FreeAndNil(FileList);
+    SysUtils.FreeAndNil(DirListing);
+  end; // .try
+end; // .procedure TestIntegrated.TestDirectoryListing;
+
 begin
   RegisterTest(TestIntegrated.Suite);
 end.

Tests/VfsMatchingTest.pas

@@ -0,0 +1,35 @@
+unit VfsMatchingTest;
+
+(***)  interface  (***)
+
+uses
+  SysUtils, TestFramework,
+  Utils, VfsMatching;
+
+type
+  TestMatching = class (TTestCase)
+   published
+    procedure TestMatchPattern;
+  end;
+
+(***)  implementation  (***)
+
+
+procedure TestMatching.TestMatchPattern ();
+begin
+  Check(VfsMatching.MatchPattern('Nice picture.bak.bmp', '<.b?p>'), '{1}');
+  CheckFalse(VfsMatching.MatchPattern('Nice picture.bak.bmp', '<.b?mp>'), '{2}');
+  Check(VfsMatching.MatchPattern('this abb is a long abba story.txt', '*abba*.>xt>>>'), '{3}');
+  Check(VfsMatching.MatchPattern('what a brave', '*??r*<"""'), '{4}');
+  Check(VfsMatching.MatchPattern('.', '*<<*""">>>*<<""'), '{5}');
+  Check(VfsMatching.MatchPattern('', ''), '{6}');
+  CheckFalse(VfsMatching.MatchPattern('opportunity.png', '*p'), '{7}');
+  Check(VfsMatching.MatchPattern('opportunity.png', '*p*'), '{8}');
+  Check(VfsMatching.MatchPattern('', '*'), '{9}');
+  Check(VfsMatching.MatchPattern('.?.', '*'), '{10}');
+  Check(VfsMatching.MatchPattern('its the last hero of the night.docx', '*the*hero<.doc?'), '{11}');
+end;
+
+begin
+  RegisterTest(TestMatching.Suite);
+end.

Tests/VfsOpenFilesTest.pas

@@ -33,8 +33,9 @@ end;
 
 procedure TestOpenFiles.GetCombinedDirListing;
 const
-  VALID_FULLY_VIRT_DIR_LISTING = 'mms.cfg'#13#10'.'#13#10'..';
+  VALID_FULLY_VIRT_DIR_LISTING  = 'mms.cfg'#13#10'.'#13#10'..';
-  VALID_COMBINED_LISTING       = 'Hobbots'#13#10'vcredist.bmp'#13#10'.'#13#10'..'#13#10'503.html'#13#10'default'#13#10'Mods';
+  VALID_COMBINED_LISTING        = 'Hobbots'#13#10'vcredist.bmp'#13#10'.'#13#10'..'#13#10'503.html'#13#10'default'#13#10'Mods';
+  VALID_COMBINED_MASKED_LISTING = '503.html';
 
 var
 {O} OpenedFile: VfsOpenFiles.TOpenedFile;
@@ -53,13 +54,20 @@ begin
   OpenedFile := VfsOpenFiles.TOpenedFile.Create(777, DirPath);
   OpenedFile.FillDirListing('*');
   Check(OpenedFile.DirListing <> nil, 'Directory listing must be assigned');
-  Check(OpenedFile.DirListing.GetDebugDump() = VALID_FULLY_VIRT_DIR_LISTING, 'Invalid listing for fully virtual directory "' + DirPath + '". Got: ' + OpenedFile.DirListing.GetDebugDump());
+  CheckEquals(VALID_FULLY_VIRT_DIR_LISTING, OpenedFile.DirListing.GetDebugDump(), 'Invalid listing for fully virtual directory "' + DirPath + '"');
   FreeAndNil(OpenedFile);
 
   OpenedFile := VfsOpenFiles.TOpenedFile.Create(888, RootDir);
   OpenedFile.FillDirListing('*');
   Check(OpenedFile.DirListing <> nil, 'Directory listing must be assigned');
-  Check(OpenedFile.DirListing.GetDebugDump() = VALID_COMBINED_LISTING, 'Invalid combined listing for directory "' + RootDir + '". Got: ' + OpenedFile.DirListing.GetDebugDump());
+  CheckEquals(VALID_COMBINED_LISTING, OpenedFile.DirListing.GetDebugDump(), 'Invalid combined listing for directory "' + RootDir + '"');
+  FreeAndNil(OpenedFile);
+
+  OpenedFile := VfsOpenFiles.TOpenedFile.Create(999, RootDir);
+  OpenedFile.FillDirListing('*.????');
+  Check(OpenedFile.DirListing <> nil, 'Directory listing must be assigned');
+  CheckEquals(VALID_COMBINED_MASKED_LISTING, OpenedFile.DirListing.GetDebugDump(), 'Invalid combined masked listing for directory "' + RootDir + '"');
+  FreeAndNil(OpenedFile);
   // * * * * * //
   SysUtils.FreeAndNil(OpenedFile);
 end;

Vfs.dpr

@@ -5,14 +5,6 @@ library Vfs;
 
 uses Windows;
 
-procedure DLLEntryPoint (Reason: DWORD);
 begin
-  // Stop VFS globally!!!!!!!!!
+  System.IsMultiThread := true;
-end;
-
-begin
-  if System.DllProc = nil then begin
-    System.DllProc := @DLLEntryPoint;
-    DllEntryPoint(Windows.DLL_PROCESS_ATTACH);
-  end;
 end.

VfsBase.pas

@@ -12,7 +12,7 @@ uses
   SysUtils, Math, Windows,
   Utils, WinNative, Alg, Concur, TypeWrappers, Lists, DataLib,
   StrLib,
-  VfsUtils;
+  VfsUtils, VfsMatching;
 
 type
   (* Import *)
@@ -98,6 +98,9 @@ function PauseVfs: boolean;
 (* Stops VFS and clears all mappings *)
 function ResetVfs: boolean;
 
+(* Returns true if VFS is active globally and for current thread *)
+function IsVfsActive: boolean;
+
 (* Returns real path for VFS item by its absolute virtual path or empty string. Optionally returns file info structure *)
 function GetVfsItemRealPath (const AbsVirtPath: WideString; {n} FileInfo: PNativeFileInfo = nil): WideString;
 
@@ -325,6 +328,12 @@ begin
   end;
 end;
 
+function IsVfsActive: boolean;
+begin
+  result := EnterVfs;
+  LeaveVfs;
+end;
+
 (* Returns real path for vfs item by its absolute virtual path or empty string. Optionally returns file info structure *)
 function GetVfsItemRealPath (const AbsVirtPath: WideString; {n} FileInfo: PNativeFileInfo = nil): WideString;
 var
@@ -351,6 +360,7 @@ function GetVfsDirInfo (const AbsVirtPath, Mask: WideString; {OUT} var DirInfo:
 var
 {n} VfsItem:        TVfsItem;
     NormalizedMask: WideString;
+    MaskPattern:    Utils.TArrayOfByte;
     i:              integer;
 
 begin
@@ -367,9 +377,10 @@ begin
 
       if VfsItem.Children <> nil then begin
         NormalizedMask := StrLib.WideLowerCase(Mask);
+        MaskPattern    := VfsMatching.CompilePattern(NormalizedMask);
 
         for i := 0 to VfsItem.Children.Count - 1 do begin
-          if StrLib.MatchW(TVfsItem(VfsItem.Children[i]).SearchName, NormalizedMask) then begin
+          if VfsMatching.MatchPattern(TVfsItem(VfsItem.Children[i]).SearchName, pointer(MaskPattern)) then begin
             DirListing.AddItem(@TVfsItem(VfsItem.Children[i]).Info);
           end;
         end;

VfsHooks.pas

@@ -252,7 +252,7 @@ begin
     result := OrigFunc(FileHandle, DesiredAccess, @ReplacedObjAttrs, IoStatusBlock, AllocationSize, FileAttributes, ShareAccess, CreateDisposition, CreateOptions, EaBuffer, EaLength);
 
     if (result = WinNative.STATUS_SUCCESS) and (ExpandedPath <> '') then begin
-      VfsOpenFiles.SetOpenedFileInfo(FileHandle^, TOpenedFile.Create(FileHandle^, ExpandedPath));
+      VfsOpenFiles.SetOpenedFileInfo(FileHandle^, TOpenedFile.Create(FileHandle^, VfsUtils.NormalizeAbsPath(ExpandedPath)));
     end;
 
     Leave;
@@ -375,6 +375,7 @@ var
      StructConvertResult:    TFileInfoConvertResult;
      EmptyMask:              UNICODE_STRING;
      EntryName:              WideString;
+     VfsIsActive:            boolean;
 
 begin
   OpenedFile := nil;
@@ -383,23 +384,24 @@ begin
   PrevEntry  := nil;
   BufSize    := 0;
   // * * * * * //
-  with OpenFilesCritSection do begin
+  with VfsOpenFiles.OpenFilesCritSection do begin
     if Mask = nil then begin
       EmptyMask.Reset;
       Mask := @EmptyMask;
     end;
 
     if VfsDebug.LoggingEnabled then begin
-      WriteLog('NtQueryDirectoryFile', Format('Handle: %x. InfoClass: %s. Mask: %s', [integer(FileHandle), WinNative.FileInformationClassToStr(InfoClass), AnsiString(Mask.ToWideStr())]));
+      WriteLog('[ENTER] NtQueryDirectoryFile', Format('Handle: %x. InfoClass: %s. Mask: %s. SingleEntry: %d', [Int(FileHandle), WinNative.FileInformationClassToStr(InfoClass), string(Mask.ToWideStr()), ord(SingleEntry)]));
     end;
 
     Enter;
 
-    // FIXME REWRITE ME
+    OpenedFile  := VfsOpenFiles.GetOpenedFile(FileHandle);
-    //OpenedFile := OpenedFiles[pointer(FileHandle)];
+    VfsIsActive := VfsBase.IsVfsActive;
 
-    if (OpenedFile = nil) or (Event <> 0) or (ApcRoutine <> nil) or (ApcContext <> nil) then begin
+    if (OpenedFile = nil) or (Event <> 0) or (ApcRoutine <> nil) or (ApcContext <> nil) or (not VfsIsActive) then begin
-      WriteLog('NtQueryDirectoryFile', Format('Calling native NtQueryDirectoryFile. OpenedFile: %x. %d %d %d', [integer(OpenedFile), integer(Event), integer(ApcRoutine), integer(ApcContext)]));
+      Leave;
+      WriteLog('[INNER] NtQueryDirectoryFile', Format('Calling native NtQueryDirectoryFile. OpenedFileRec: %x, VfsIsOn: %d, Event: %d. ApcRoutine: %d. ApcContext: %d', [Int(OpenedFile), ord(VfsIsActive), Int(Event), Int(ApcRoutine), Int(ApcContext)]));
       result := OrigFunc(FileHandle, Event, ApcRoutine, ApcContext, Io, Buffer, BufLength, InfoClass, SingleEntry, Mask, RestartScan);
     end else begin
       int(Io.Information) := 0;
@@ -434,12 +436,20 @@ begin
         Proceed := not OpenedFile.DirListing.IsEnd;
 
         if not Proceed then begin
-          result := STATUS_NO_MORE_FILES;
+          if OpenedFile.DirListing.Count > 0 then begin
+            result := STATUS_NO_MORE_FILES;
+          end else begin
+            result := STATUS_NO_SUCH_FILE;
+          end;
         end;
       end;
 
       // Scan directory
       if Proceed then begin
+        if VfsDebug.LoggingEnabled then begin
+          WriteLog('[INNER] NtQueryDirectoryFile', Format('Writing entries for buffer of size %d. Single entry: %d', [BufSize, ord(SingleEntry)]));
+        end;
+
         BufCurret    := Buffer;
         BytesWritten := 1;
 
@@ -460,11 +470,9 @@ begin
 
           if VfsDebug.LoggingEnabled then begin
             EntryName := Copy(FileInfo.Data.FileName, 1, Min(BytesWritten - WinNative.GetFileInformationClassSize(InfoClass), FileInfo.Data.Base.FileNameLength) div 2);
-            WriteLog('NtQueryDirectoryFile', 'Written entry: ' + EntryName);
+            WriteLog('[INNER] NtQueryDirectoryFile', 'Written entry: ' + EntryName);
           end;
 
-          //VarDump(['Converted struct to buf offset:', int(BufCurret) - int(Buffer), 'Written:', BytesWritten, 'Result:', ord(StructConvertResult)]);
-
           with PFILE_ID_BOTH_DIR_INFORMATION(BufCurret)^ do begin
             NextEntryOffset := 0;
             FileIndex       := 0;
@@ -497,8 +505,6 @@ begin
 
           PrevEntry := BufCurret;
 
-          //Msg(Format('Written: %d. Total: %d', [BytesWritten, int(Io.Information)]));
-
           if SingleEntry then begin
             BytesWritten := 0;
           end;
@@ -506,20 +512,21 @@ begin
       end; // .if    
 
       Io.Status.Status := result;
-    end; // .else
 
-    Leave;
+      Leave;
+    end; // .else
   end; // .with
 
   if VfsDebug.LoggingEnabled then begin
-    WriteLog('NtQueryDirectoryFile', Format('Status: %x. Written: %d bytes', [integer(result), integer(Io.Information)]));
+    WriteLog('[LEAVE] NtQueryDirectoryFile', Format('Handle: %x. Status: %x. Written: %d bytes', [int(FileHandle), int(result), int(Io.Information)]));
   end;
 end; // .function Hook_NtQueryDirectoryFile
 
 procedure InstallHooks;
 var
-  hDll:        Windows.THandle;
+  SetProcessDEPPolicy: function (dwFlags: integer): LONGBOOL; stdcall;
-  NtdllHandle: integer;
+  hDll:                Windows.THandle;
+  NtdllHandle:         integer;
 
 begin
   with HooksCritSection do begin
@@ -528,6 +535,17 @@ begin
     if not HooksInstalled then begin
       HooksInstalled := true;
 
+      (* Trying to turn off DEP *)
+      SetProcessDEPPolicy := Windows.GetProcAddress(Windows.GetModuleHandle('kernel32.dll'), 'SetProcessDEPPolicy');
+
+      if @SetProcessDEPPolicy <> nil then begin
+        if SetProcessDEPPolicy(0) then begin
+          WriteLog('SetProcessDEPPolicy', 'DEP was turned off');
+        end else begin
+          WriteLog('SetProcessDEPPolicy', 'Failed to turn DEP off');
+        end;
+      end;
+
       // Ensure, that library with VFS hooks installed is never unloaded
       if System.IsLibrary then begin
         WinNative.GetModuleHandleExW(WinNative.GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS or WinNative.GET_MODULE_HANDLE_EX_FLAG_PIN, @InstallHooks, hDll);
@@ -576,12 +594,12 @@ begin
         @NtClosePatch
       );
 
-      // WriteLog('InstallHook', 'Installing NtQueryDirectoryFile hook');
+      WriteLog('InstallHook', 'Installing NtQueryDirectoryFile hook');
-      // NativeNtQueryDirectoryFile := VfsPatching.SpliceWinApi
+      NativeNtQueryDirectoryFile := VfsPatching.SpliceWinApi
-      // (
+      (
-      //   VfsApiDigger.GetRealProcAddress(NtdllHandle, 'NtQueryDirectoryFile'),
+        VfsApiDigger.GetRealProcAddress(NtdllHandle, 'NtQueryDirectoryFile'),
-      //   @Hook_NtQueryDirectoryFile
+        @Hook_NtQueryDirectoryFile
-      // );
+      );
     end; // .if
 
     Leave;
@@ -598,6 +616,7 @@ begin
     NtOpenFilePatch.Rollback;
     NtCreateFilePatch.Rollback;
     NtClosePatch.Rollback;
+    NtQueryDirectoryFilePatch.Rollback;
 
     Leave;
   end;

VfsMatching.pas

@@ -0,0 +1,276 @@
+unit VfsMatching;
+(*
+  Description: Implements NT files matching strategy, same as RtlIsNameInExpression.
+  @link https://blogs.msdn.microsoft.com/jeremykuhne/2017/06/04/wildcards-in-windows/
+  @link https://devblogs.microsoft.com/oldnewthing/?p=24143
+*)
+
+
+(***)  interface  (***)
+
+uses
+  SysUtils,
+  Utils, PatchForge;
+
+
+function CompilePattern (const Pattern: WideString): Utils.TArrayOfByte;
+function MatchPattern (const Str: WideString; {n} Pattern: pointer): boolean; overload;
+function MatchPattern (const Str, Pattern: WideString): boolean; overload;
+
+
+(***)  implementation  (***)
+
+
+const
+  (* File name without last separator and extension: ~([^.]*+\z|.*(?=\.))~ *)
+  DOS_STAR = '<';
+  
+  (* Dos single char or before dot/end: ~((?=\.)|.?)~ *)
+  DOS_QM = '>';
+
+  (* Dos dot or string end: ~(\.|\z)~ *)
+  DOS_DOT = '"';
+
+  MAX_STR_LEN = High(word);
+
+
+type
+  TPatternKind = (KIND_CHAR, KIND_ANY_CHAR, KIND_ANY_CHARS, KIND_DOS_ANY_CHAR, KIND_DOS_ANY_CHARS, KIND_DOS_DOT, KIND_END);
+
+  PPattern = ^TPattern;
+  TPattern = record
+    Kind: TPatternKind;
+    Len:  word;
+    Ch:   WideChar;
+  end;
+
+
+function CompilePattern (const Pattern: WideString): Utils.TArrayOfByte;
+var
+{O} Compiled:        PatchForge.TPatchHelper;
+    PrevPatternKind: TPatternKind;
+    NextPatternKind: TPatternKind;
+    SkipPattern:     boolean;
+    c:               WideChar;
+    i:               integer;
+
+begin
+  Compiled := PatchForge.TPatchHelper.Wrap(PatchForge.TPatchMaker.Create);
+  // * * * * * //
+  PrevPatternKind := KIND_END;
+
+  for i := 1 to Length(Pattern) do begin
+    c           := Pattern[i];
+    SkipPattern := false;
+
+    case c of
+      '?': NextPatternKind := KIND_ANY_CHAR;
+      
+      '*': begin
+        NextPatternKind := KIND_ANY_CHARS;
+        SkipPattern     := PrevPatternKind = KIND_ANY_CHARS;
+      end;
+
+      DOS_STAR: begin
+        NextPatternKind := KIND_DOS_ANY_CHARS;
+        SkipPattern     := PrevPatternKind = KIND_DOS_ANY_CHARS;
+      end;
+      
+      DOS_QM: NextPatternKind := KIND_DOS_ANY_CHAR;
+      
+      DOS_DOT: NextPatternKind := KIND_DOS_DOT;
+    else
+      NextPatternKind := KIND_CHAR;
+    end; // .switch
+
+    if not SkipPattern then begin
+      with PPattern(Compiled.AllocAndSkip(sizeof(TPattern)))^ do begin
+        Kind := NextPatternKind;
+        Ch   := c;
+      end;
+    end;
+
+    PrevPatternKind := NextPatternKind;
+  end; // .for
+
+  PPattern(Compiled.AllocAndSkip(sizeof(TPattern))).Kind := KIND_END;
+  result := Compiled.GetPatch;
+  // * * * * * //
+  Compiled.Release;
+end; // .function CompilePattern
+
+function MatchPattern (const Str: WideString; {n} Pattern: pointer): boolean; overload;
+var
+{Un} Subpattern: PPattern;
+     StrLen:     integer;
+     StrStart:   PWideChar;
+     StrEnd:     PWideChar;
+     s:          PWideChar;
+
+  function MatchSubpattern: boolean;
+  var
+    DotFinder: PWideChar;
+
+  begin
+    result         := false;
+    Subpattern.Len := 1;
+
+    case Subpattern.Kind of
+      KIND_CHAR: begin
+        result := s^ = Subpattern.Ch;
+      end;
+
+      KIND_ANY_CHAR: begin
+        result := s <> StrEnd;
+      end;
+
+      KIND_DOS_ANY_CHAR: begin
+        result := true;
+
+        if (s^ = '.') or (s = StrEnd) then begin
+          Subpattern.Len := 0;
+        end;
+      end;
+
+      KIND_DOS_DOT: begin
+        result := (s^ = '.') or (s = StrEnd);
+        
+        if s = StrEnd then begin
+          Subpattern.Len := 0;
+        end;
+      end;
+
+      KIND_DOS_ANY_CHARS: begin
+        result := true;
+
+        if s^ <> '.' then begin
+          DotFinder := StrEnd;
+
+          while (DotFinder > s) and (DotFinder^ <> '.') do begin
+            Dec(DotFinder);
+          end;
+
+          if DotFinder^ <> '.' then begin
+            DotFinder := StrEnd;
+          end;
+        end else begin
+          DotFinder := s;
+        end;
+
+        Subpattern.Len := DotFinder - s;
+      end; // .case KIND_DOS_ANY_CHARS
+
+      KIND_ANY_CHARS: begin
+        result         := true;
+        Subpattern.Len := 0;
+      end;
+
+      KIND_END: begin
+        result         := s = StrEnd;
+        Subpattern.Len := 0;
+      end;
+    end; // .switch
+
+    if result then begin
+      Inc(s, Subpattern.Len);
+    end;
+  end; // .function MatchSubpattern
+
+  function Recover: boolean;
+  var
+    NextSubpattern: PPattern;
+    NextChar:       WideChar;
+    Caret:          PWideChar;
+
+  begin
+    result := false;
+
+    while not result and (cardinal(Subpattern) >= cardinal(Pattern)) do begin
+      case Subpattern.Kind of
+        KIND_ANY_CHARS: begin
+          if s < StrEnd then begin
+            result         := true;
+            NextSubpattern := Utils.PtrOfs(Subpattern, sizeof(TPattern));
+            Inc(Subpattern.Len);
+            Inc(s);
+  
+            (* Fast consume to the end: xxx* *)
+            if NextSubpattern.Kind = KIND_END then begin
+              Inc(Subpattern.Len, StrEnd - s);
+              s := StrEnd;
+            end
+            (* Fast search for special character: *carry *)
+            else if NextSubpattern.Kind = KIND_CHAR then begin
+              NextChar := NextSubpattern.Ch;
+              Caret    := s;
+              
+              while (Caret < StrEnd) and (Caret^ <> NextChar) do begin
+                Inc(Caret);
+              end;
+
+              if Caret < StrEnd then begin
+                Inc(Subpattern.Len, Caret - s);
+                s := Caret;
+              end else begin
+                result := false;
+              end;              
+            end; // .elseif
+          end else begin
+            Dec(s, Subpattern.Len);
+          end; // .else
+        end; // .case KIND_ANY_CHARS
+      else
+        Dec(s, Subpattern.Len);
+      end; // .switch
+
+      if result then begin
+        Inc(Subpattern);
+      end else begin
+        Dec(Subpattern);
+      end;
+    end; // .while
+  end; // .function Recover
+
+begin
+  Subpattern := Pattern;
+  StrLen     := Length(Str);
+  StrStart   := PWideChar(Str);
+  StrEnd     := StrStart + StrLen;
+  s          := StrStart;
+  // * * * * * //
+  if Pattern = nil then begin
+    result := Str = '';
+    exit;
+  end;
+
+  if StrLen > MAX_STR_LEN then begin
+    result := false;
+    exit;
+  end;
+
+  while cardinal(Subpattern) >= cardinal(Pattern) do begin
+    if MatchSubpattern then begin
+      if Subpattern.Kind = KIND_END then begin
+        break;
+      end;
+
+      Inc(Subpattern);
+    end else begin
+      Dec(Subpattern);
+      Recover;
+    end;
+  end;
+
+  result := (cardinal(Subpattern) >= cardinal(Pattern)) and (s^ = #0);
+end; // .function MatchPattern
+
+function MatchPattern (const Str, Pattern: WideString): boolean; overload;
+var
+  CompiledPattern: Utils.TArrayOfByte;
+
+begin
+  CompiledPattern := CompilePattern(Pattern);
+  result          := MatchPattern(Str, pointer(CompiledPattern));
+end;
+
+end.

VfsOpenFiles.pas

@@ -14,7 +14,7 @@ unit VfsOpenFiles;
 uses
   Windows, SysUtils,
   Utils, Concur, DataLib, StrLib,
-  VfsUtils, VfsBase;
+  VfsUtils, VfsBase, VfsMatching;
 
 type
   (* Import *)
@@ -44,6 +44,9 @@ var
   OpenFilesCritSection: Concur.TCritSection;
 
 
+(* Returns TOpenedFile by handle or nil. MUST BE called in OpenFilesCritSection protected area *)
+function GetOpenedFile (hFile: Windows.THandle): {n} TOpenedFile;
+
 (* Returns absolute virtual/real path to opened file by its handle in a thread-safe way. Empty string on failure. The result path is the one, passed to open file API *)
 function GetOpenedFilePath (hFile: Windows.THandle): WideString;
 
@@ -81,7 +84,6 @@ var
      DirInfo:        TNativeFileInfo;
      ParentDirInfo:  TNativeFileInfo;
      DirItem:        TFileInfo;
-     i:              integer;
 
 begin
   ExcludedItems := nil;
@@ -113,11 +115,11 @@ begin
 
   // No real items added, maybe there is a need to add '.' and/or '..' manually
   if VfsItemFound and (Self.DirListing.Count = NumVfsChildren) then begin
-    if StrLib.MatchW('.', Mask) then begin
+    if VfsMatching.MatchPattern('.', Mask) then begin
       Self.DirListing.AddItem(@DirInfo, '.');
     end;
 
-    if StrLib.MatchW('..', Mask) and VfsUtils.GetFileInfo(Self.AbsPath + '\..', ParentDirInfo) then begin
+    if VfsMatching.MatchPattern('..', Mask) and VfsUtils.GetFileInfo(Self.AbsPath + '\..', ParentDirInfo) then begin
       Self.DirListing.AddItem(@ParentDirInfo, '..');
     end;
   end;
@@ -125,6 +127,11 @@ begin
   SysUtils.FreeAndNil(ExcludedItems);
 end; // .procedure TOpenedFile.FillDirListing
 
+function GetOpenedFile (hFile: Windows.THandle): {n} TOpenedFile;
+begin
+  result := OpenedFiles[pointer(hFile)];
+end;
+
 function GetOpenedFilePath (hFile: Windows.THandle): WideString;
 var
 {n} OpenedFile: TOpenedFile;

VfsTest.dpr

@@ -4,13 +4,13 @@ uses
   TestFramework, GuiTestRunner,
   VfsUtils, VfsBase, VfsDebug,
   VfsApiDigger, VfsExport, VfsOpenFiles,
-  VfsHooks, VfsControl,
+  VfsHooks, VfsControl, VfsMatching,
-  VfsTestHelper,
+  VfsTestHelper, VfsMatchingTest,
   VfsDebugTest, VfsUtilsTest, VfsBaseTest,
   VfsApiDiggerTest, VfsOpenFilesTest, VfsIntegratedTest;
 
 begin
+  System.IsMultiThread := true;
   VfsTestHelper.InitConsole;
   TGUITestRunner.RunRegisteredTests;
 end.
-

VfsTest.dproj

@@ -1,4 +1,5 @@
-<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+<?xml version="1.0" encoding="utf-8"?>
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
   <PropertyGroup>
     <ProjectGuid>{c6015c7b-4070-47b6-8c8a-c2b54aba82d6}</ProjectGuid>
     <MainSource>VfsTest.dpr</MainSource>
@@ -22,6 +23,8 @@
     <DCC_ResourcePath>..\Lib\B2;.\Tests</DCC_ResourcePath>
     <DCC_ObjPath>..\Lib\B2;.\Tests</DCC_ObjPath>
     <DCC_IncludePath>..\Lib\B2;.\Tests</DCC_IncludePath>
+    <DCC_MapFile>3</DCC_MapFile>
+    <DCC_Optimize>False</DCC_Optimize>
   </PropertyGroup>
   <ProjectExtensions>
     <Borland.Personality>Delphi.Personality</Borland.Personality>
@@ -36,6 +39,34 @@
       
       
       
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
+      
       <Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
       <Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
     </Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject>

VfsTest.drc

@@ -0,0 +1,503 @@
+/* VER185
+  Generated by the CodeGear Delphi Pascal Compiler
+  because -GD or --drc was supplied to the compiler.
+
+  This file contains compiler-generated resources that
+  were bound to the executable.
+  If this file is empty, then no compiler-generated
+  resources were bound to the produced executable.
+*/
+
+#define ComStrs_sRichEditSaveFail 65280
+#define ComStrs_sInvalidComCtl32 65281
+#define Consts_SDockZoneHasNoCtl 65296
+#define Consts_SDockZoneVersionConflict 65297
+#define Consts_SMultiSelectRequired 65298
+#define Consts_SSeparator 65299
+#define Consts_SNoGetItemEventHandler 65300
+#define Consts_SANSIEncoding 65301
+#define Consts_SASCIIEncoding 65302
+#define Consts_SUnicodeEncoding 65303
+#define Consts_SBigEndianEncoding 65304
+#define Consts_SUTF8Encoding 65305
+#define Consts_SUTF7Encoding 65306
+#define ComStrs_sInvalidIndex 65307
+#define ComStrs_sInsertError 65308
+#define ComStrs_sInvalidOwner 65309
+#define ComStrs_sRichEditInsertError 65310
+#define ComStrs_sRichEditLoadFail 65311
+#define Consts_SmkcDown 65312
+#define Consts_SmkcIns 65313
+#define Consts_SmkcDel 65314
+#define Consts_SmkcShift 65315
+#define Consts_SmkcCtrl 65316
+#define Consts_SmkcAlt 65317
+#define Consts_SOutOfRange 65318
+#define Consts_SInvalidClipFmt 65319
+#define Consts_SIconToClipboard 65320
+#define Consts_SCannotOpenClipboard 65321
+#define Consts_SInvalidMemoSize 65322
+#define Consts_SNoDefaultPrinter 65323
+#define Consts_SDuplicateMenus 65324
+#define Consts_SDockedCtlNeedsName 65325
+#define Consts_SDockTreeRemoveError 65326
+#define Consts_SDockZoneNotFound 65327
+#define Consts_SMsgDlgIgnore 65328
+#define Consts_SMsgDlgAll 65329
+#define Consts_SMsgDlgNoToAll 65330
+#define Consts_SMsgDlgYesToAll 65331
+#define Consts_SmkcBkSp 65332
+#define Consts_SmkcTab 65333
+#define Consts_SmkcEsc 65334
+#define Consts_SmkcEnter 65335
+#define Consts_SmkcSpace 65336
+#define Consts_SmkcPgUp 65337
+#define Consts_SmkcPgDn 65338
+#define Consts_SmkcEnd 65339
+#define Consts_SmkcHome 65340
+#define Consts_SmkcLeft 65341
+#define Consts_SmkcUp 65342
+#define Consts_SmkcRight 65343
+#define Consts_SIgnoreButton 65344
+#define Consts_SRetryButton 65345
+#define Consts_SAbortButton 65346
+#define Consts_SAllButton 65347
+#define Consts_SCannotDragForm 65348
+#define Consts_SMsgDlgWarning 65349
+#define Consts_SMsgDlgError 65350
+#define Consts_SMsgDlgInformation 65351
+#define Consts_SMsgDlgConfirm 65352
+#define Consts_SMsgDlgYes 65353
+#define Consts_SMsgDlgNo 65354
+#define Consts_SMsgDlgOK 65355
+#define Consts_SMsgDlgCancel 65356
+#define Consts_SMsgDlgHelp 65357
+#define Consts_SMsgDlgAbort 65358
+#define Consts_SMsgDlgRetry 65359
+#define Consts_SMenuReinserted 65360
+#define Consts_SMenuNotFound 65361
+#define Consts_SNoTimers 65362
+#define Consts_SNotPrinting 65363
+#define Consts_SPrinting 65364
+#define Consts_SInvalidPrinter 65365
+#define Consts_SDeviceOnPort 65366
+#define Consts_SGroupIndexTooLow 65367
+#define Consts_SNoMDIForm 65368
+#define Consts_SControlParentSetToSelf 65369
+#define Consts_SOKButton 65370
+#define Consts_SCancelButton 65371
+#define Consts_SYesButton 65372
+#define Consts_SNoButton 65373
+#define Consts_SHelpButton 65374
+#define Consts_SCloseButton 65375
+#define Consts_SNoCanvasHandle 65376
+#define Consts_SInvalidImageSize 65377
+#define Consts_SInvalidImageList 65378
+#define Consts_SImageIndexError 65379
+#define Consts_SImageReadFail 65380
+#define Consts_SImageWriteFail 65381
+#define Consts_SWindowDCError 65382
+#define Consts_SWindowClass 65383
+#define Consts_SCannotFocus 65384
+#define Consts_SParentRequired 65385
+#define Consts_SParentGivenNotAParent 65386
+#define Consts_SMDIChildNotVisible 65387
+#define Consts_SVisibleChanged 65388
+#define Consts_SCannotShowModal 65389
+#define Consts_SPropertyOutOfRange 65390
+#define Consts_SMenuIndexError 65391
+#define RTLConsts_SSeekNotImplemented 65392
+#define RTLConsts_SSortedListError 65393
+#define RTLConsts_SUnknownGroup 65394
+#define RTLConsts_SUnknownProperty 65395
+#define RTLConsts_SWriteError 65396
+#define HelpIntfs_hNoTableOfContents 65397
+#define HelpIntfs_hNothingFound 65398
+#define HelpIntfs_hNoContext 65399
+#define HelpIntfs_hNoContextFound 65400
+#define HelpIntfs_hNoTopics 65401
+#define Consts_SInvalidBitmap 65402
+#define Consts_SInvalidIcon 65403
+#define Consts_SInvalidMetafile 65404
+#define Consts_SChangeIconSize 65405
+#define Consts_SUnknownClipboardFormat 65406
+#define Consts_SOutOfResources 65407
+#define RTLConsts_SInvalidName 65408
+#define RTLConsts_SInvalidProperty 65409
+#define RTLConsts_SInvalidPropertyPath 65410
+#define RTLConsts_SInvalidPropertyValue 65411
+#define RTLConsts_SInvalidRegType 65412
+#define RTLConsts_SListCapacityError 65413
+#define RTLConsts_SListCountError 65414
+#define RTLConsts_SListIndexError 65415
+#define RTLConsts_SMemoryStreamError 65416
+#define RTLConsts_SPropertyException 65417
+#define RTLConsts_SReadError 65418
+#define RTLConsts_SReadOnlyProperty 65419
+#define RTLConsts_SRegCreateFailed 65420
+#define RTLConsts_SRegGetDataFailed 65421
+#define RTLConsts_SRegSetDataFailed 65422
+#define RTLConsts_SResNotFound 65423
+#define SysConst_SLongDayNameFri 65424
+#define SysConst_SLongDayNameSat 65425
+#define RTLConsts_SAncestorNotFound 65426
+#define RTLConsts_SAssignError 65427
+#define RTLConsts_SBitsIndexError 65428
+#define RTLConsts_SCantWriteResourceStreamError 65429
+#define RTLConsts_SCheckSynchronizeError 65430
+#define RTLConsts_SClassNotFound 65431
+#define RTLConsts_SDuplicateClass 65432
+#define RTLConsts_SDuplicateItem 65433
+#define RTLConsts_SDuplicateName 65434
+#define RTLConsts_SDuplicateString 65435
+#define RTLConsts_SFCreateErrorEx 65436
+#define RTLConsts_SFOpenErrorEx 65437
+#define RTLConsts_SIniFileWriteError 65438
+#define RTLConsts_SInvalidImage 65439
+#define SysConst_SLongMonthNameSep 65440
+#define SysConst_SLongMonthNameOct 65441
+#define SysConst_SLongMonthNameNov 65442
+#define SysConst_SLongMonthNameDec 65443
+#define SysConst_SShortDayNameSun 65444
+#define SysConst_SShortDayNameMon 65445
+#define SysConst_SShortDayNameTue 65446
+#define SysConst_SShortDayNameWed 65447
+#define SysConst_SShortDayNameThu 65448
+#define SysConst_SShortDayNameFri 65449
+#define SysConst_SShortDayNameSat 65450
+#define SysConst_SLongDayNameSun 65451
+#define SysConst_SLongDayNameMon 65452
+#define SysConst_SLongDayNameTue 65453
+#define SysConst_SLongDayNameWed 65454
+#define SysConst_SLongDayNameThu 65455
+#define SysConst_SShortMonthNameMay 65456
+#define SysConst_SShortMonthNameJun 65457
+#define SysConst_SShortMonthNameJul 65458
+#define SysConst_SShortMonthNameAug 65459
+#define SysConst_SShortMonthNameSep 65460
+#define SysConst_SShortMonthNameOct 65461
+#define SysConst_SShortMonthNameNov 65462
+#define SysConst_SShortMonthNameDec 65463
+#define SysConst_SLongMonthNameJan 65464
+#define SysConst_SLongMonthNameFeb 65465
+#define SysConst_SLongMonthNameMar 65466
+#define SysConst_SLongMonthNameApr 65467
+#define SysConst_SLongMonthNameMay 65468
+#define SysConst_SLongMonthNameJun 65469
+#define SysConst_SLongMonthNameJul 65470
+#define SysConst_SLongMonthNameAug 65471
+#define SysConst_SVarBadType 65472
+#define SysConst_SVarNotImplemented 65473
+#define SysConst_SVarUnexpected 65474
+#define SysConst_SExternalException 65475
+#define SysConst_SAssertionFailed 65476
+#define SysConst_SIntfCastError 65477
+#define SysConst_SSafecallException 65478
+#define SysConst_SAssertError 65479
+#define SysConst_SAbstractError 65480
+#define SysConst_SModuleAccessViolation 65481
+#define SysConst_SOSError 65482
+#define SysConst_SUnkOSError 65483
+#define SysConst_SShortMonthNameJan 65484
+#define SysConst_SShortMonthNameFeb 65485
+#define SysConst_SShortMonthNameMar 65486
+#define SysConst_SShortMonthNameApr 65487
+#define SysConst_SInvalidFormat 65488
+#define SysConst_SArgumentMissing 65489
+#define SysConst_SDispatchError 65490
+#define SysConst_SReadAccess 65491
+#define SysConst_SWriteAccess 65492
+#define SysConst_SVarArrayCreate 65493
+#define SysConst_SVarArrayBounds 65494
+#define SysConst_SVarArrayLocked 65495
+#define SysConst_SInvalidVarCast 65496
+#define SysConst_SInvalidVarOp 65497
+#define SysConst_SInvalidVarNullOp 65498
+#define SysConst_SInvalidVarOpWithHResultWithPrefix 65499
+#define SysConst_SVarTypeCouldNotConvert 65500
+#define SysConst_SVarTypeConvertOverflow 65501
+#define SysConst_SVarOverflow 65502
+#define SysConst_SVarInvalid 65503
+#define SysConst_SDivByZero 65504
+#define SysConst_SRangeError 65505
+#define SysConst_SIntOverflow 65506
+#define SysConst_SInvalidOp 65507
+#define SysConst_SZeroDivide 65508
+#define SysConst_SOverflow 65509
+#define SysConst_SUnderflow 65510
+#define SysConst_SInvalidPointer 65511
+#define SysConst_SInvalidCast 65512
+#define SysConst_SAccessViolationArg3 65513
+#define SysConst_SAccessViolationNoArg 65514
+#define SysConst_SStackOverflow 65515
+#define SysConst_SControlC 65516
+#define SysConst_SPrivilege 65517
+#define SysConst_SException 65518
+#define SysConst_SExceptTitle 65519
+#define SysConst_SInvalidInteger 65520
+#define SysConst_SInvalidFloat 65521
+#define SysConst_SInvalidDate 65522
+#define SysConst_SInvalidTime 65523
+#define SysConst_SInvalidDateTime 65524
+#define SysConst_STimeEncodeError 65525
+#define SysConst_SDateEncodeError 65526
+#define SysConst_SOutOfMemory 65527
+#define SysConst_SInOutError 65528
+#define SysConst_SFileNotFound 65529
+#define SysConst_SInvalidFilename 65530
+#define SysConst_STooManyOpenFiles 65531
+#define SysConst_SAccessDenied 65532
+#define SysConst_SEndOfFile 65533
+#define SysConst_SDiskFull 65534
+#define SysConst_SInvalidInput 65535
+STRINGTABLE
+BEGIN
+	ComStrs_sRichEditSaveFail,	"Failed to Save Stream"
+	ComStrs_sInvalidComCtl32,	"This control requires version 4.70 or greater of COMCTL32.DLL"
+	Consts_SDockZoneHasNoCtl,	" - Dock zone has no control"
+	Consts_SDockZoneVersionConflict,	"Error loading dock zone from the stream. Expecting version %d, but found %d."
+	Consts_SMultiSelectRequired,	"Multiselect mode must be on for this feature"
+	Consts_SSeparator,	"Separator"
+	Consts_SNoGetItemEventHandler,	"No OnGetItem event handler assigned"
+	Consts_SANSIEncoding,	"ANSI"
+	Consts_SASCIIEncoding,	"ASCII"
+	Consts_SUnicodeEncoding,	"Unicode"
+	Consts_SBigEndianEncoding,	"Big Endian Unicode"
+	Consts_SUTF8Encoding,	"UTF-8"
+	Consts_SUTF7Encoding,	"UTF-7"
+	ComStrs_sInvalidIndex,	"Invalid index"
+	ComStrs_sInsertError,	"Unable to insert an item"
+	ComStrs_sInvalidOwner,	"Invalid owner"
+	ComStrs_sRichEditInsertError,	"RichEdit line insertion error"
+	ComStrs_sRichEditLoadFail,	"Failed to Load Stream"
+	Consts_SmkcDown,	"Down"
+	Consts_SmkcIns,	"Ins"
+	Consts_SmkcDel,	"Del"
+	Consts_SmkcShift,	"Shift+"
+	Consts_SmkcCtrl,	"Ctrl+"
+	Consts_SmkcAlt,	"Alt+"
+	Consts_SOutOfRange,	"Value must be between %d and %d"
+	Consts_SInvalidClipFmt,	"Invalid clipboard format"
+	Consts_SIconToClipboard,	"Clipboard does not support Icons"
+	Consts_SCannotOpenClipboard,	"Cannot open clipboard"
+	Consts_SInvalidMemoSize,	"Text exceeds memo capacity"
+	Consts_SNoDefaultPrinter,	"There is no default printer currently selected"
+	Consts_SDuplicateMenus,	"Menu '%s' is already being used by another form"
+	Consts_SDockedCtlNeedsName,	"Docked control must have a name"
+	Consts_SDockTreeRemoveError,	"Error removing control from dock tree"
+	Consts_SDockZoneNotFound,	" - Dock zone not found"
+	Consts_SMsgDlgIgnore,	"&Ignore"
+	Consts_SMsgDlgAll,	"&All"
+	Consts_SMsgDlgNoToAll,	"N&o to All"
+	Consts_SMsgDlgYesToAll,	"Yes to &All"
+	Consts_SmkcBkSp,	"BkSp"
+	Consts_SmkcTab,	"Tab"
+	Consts_SmkcEsc,	"Esc"
+	Consts_SmkcEnter,	"Enter"
+	Consts_SmkcSpace,	"Space"
+	Consts_SmkcPgUp,	"PgUp"
+	Consts_SmkcPgDn,	"PgDn"
+	Consts_SmkcEnd,	"End"
+	Consts_SmkcHome,	"Home"
+	Consts_SmkcLeft,	"Left"
+	Consts_SmkcUp,	"Up"
+	Consts_SmkcRight,	"Right"
+	Consts_SIgnoreButton,	"&Ignore"
+	Consts_SRetryButton,	"&Retry"
+	Consts_SAbortButton,	"Abort"
+	Consts_SAllButton,	"&All"
+	Consts_SCannotDragForm,	"Cannot drag a form"
+	Consts_SMsgDlgWarning,	"Warning"
+	Consts_SMsgDlgError,	"Error"
+	Consts_SMsgDlgInformation,	"Information"
+	Consts_SMsgDlgConfirm,	"Confirm"
+	Consts_SMsgDlgYes,	"&Yes"
+	Consts_SMsgDlgNo,	"&No"
+	Consts_SMsgDlgOK,	"OK"
+	Consts_SMsgDlgCancel,	"Cancel"
+	Consts_SMsgDlgHelp,	"&Help"
+	Consts_SMsgDlgAbort,	"&Abort"
+	Consts_SMsgDlgRetry,	"&Retry"
+	Consts_SMenuReinserted,	"Menu inserted twice"
+	Consts_SMenuNotFound,	"Sub-menu is not in menu"
+	Consts_SNoTimers,	"Not enough timers available"
+	Consts_SNotPrinting,	"Printer is not currently printing"
+	Consts_SPrinting,	"Printing in progress"
+	Consts_SInvalidPrinter,	"Printer selected is not valid"
+	Consts_SDeviceOnPort,	"%s on %s"
+	Consts_SGroupIndexTooLow,	"GroupIndex cannot be less than a previous menu item's GroupIndex"
+	Consts_SNoMDIForm,	"Cannot create form. No MDI forms are currently active"
+	Consts_SControlParentSetToSelf,	"A control cannot have itself as its parent"
+	Consts_SOKButton,	"OK"
+	Consts_SCancelButton,	"Cancel"
+	Consts_SYesButton,	"&Yes"
+	Consts_SNoButton,	"&No"
+	Consts_SHelpButton,	"&Help"
+	Consts_SCloseButton,	"&Close"
+	Consts_SNoCanvasHandle,	"Canvas does not allow drawing"
+	Consts_SInvalidImageSize,	"Invalid image size"
+	Consts_SInvalidImageList,	"Invalid ImageList"
+	Consts_SImageIndexError,	"Invalid ImageList Index"
+	Consts_SImageReadFail,	"Failed to read ImageList data from stream"
+	Consts_SImageWriteFail,	"Failed to write ImageList data to stream"
+	Consts_SWindowDCError,	"Error creating window device context"
+	Consts_SWindowClass,	"Error creating window class"
+	Consts_SCannotFocus,	"Cannot focus a disabled or invisible window"
+	Consts_SParentRequired,	"Control '%s' has no parent window"
+	Consts_SParentGivenNotAParent,	"Parent given is not a parent of '%s'"
+	Consts_SMDIChildNotVisible,	"Cannot hide an MDI Child Form"
+	Consts_SVisibleChanged,	"Cannot change Visible in OnShow or OnHide"
+	Consts_SCannotShowModal,	"Cannot make a visible window modal"
+	Consts_SPropertyOutOfRange,	"%s property out of range"
+	Consts_SMenuIndexError,	"Menu index out of range"
+	RTLConsts_SSeekNotImplemented,	"%s.Seek not implemented"
+	RTLConsts_SSortedListError,	"Operation not allowed on sorted list"
+	RTLConsts_SUnknownGroup,	"%s not in a class registration group"
+	RTLConsts_SUnknownProperty,	"Property %s does not exist"
+	RTLConsts_SWriteError,	"Stream write error"
+	HelpIntfs_hNoTableOfContents,	"Unable to find a Table of Contents"
+	HelpIntfs_hNothingFound,	"No help found for %s"
+	HelpIntfs_hNoContext,	"No context-sensitive help installed"
+	HelpIntfs_hNoContextFound,	"No help found for context"
+	HelpIntfs_hNoTopics,	"No topic-based help system installed"
+	Consts_SInvalidBitmap,	"Bitmap image is not valid"
+	Consts_SInvalidIcon,	"Icon image is not valid"
+	Consts_SInvalidMetafile,	"Metafile is not valid"
+	Consts_SChangeIconSize,	"Cannot change the size of an icon"
+	Consts_SUnknownClipboardFormat,	"Unsupported clipboard format"
+	Consts_SOutOfResources,	"Out of system resources"
+	RTLConsts_SInvalidName,	"''%s'' is not a valid component name"
+	RTLConsts_SInvalidProperty,	"Invalid property value"
+	RTLConsts_SInvalidPropertyPath,	"Invalid property path"
+	RTLConsts_SInvalidPropertyValue,	"Invalid property value"
+	RTLConsts_SInvalidRegType,	"Invalid data type for '%s'"
+	RTLConsts_SListCapacityError,	"List capacity out of bounds (%d)"
+	RTLConsts_SListCountError,	"List count out of bounds (%d)"
+	RTLConsts_SListIndexError,	"List index out of bounds (%d)"
+	RTLConsts_SMemoryStreamError,	"Out of memory while expanding memory stream"
+	RTLConsts_SPropertyException,	"Error reading %s%s%s: %s"
+	RTLConsts_SReadError,	"Stream read error"
+	RTLConsts_SReadOnlyProperty,	"Property is read-only"
+	RTLConsts_SRegCreateFailed,	"Failed to create key %s"
+	RTLConsts_SRegGetDataFailed,	"Failed to get data for '%s'"
+	RTLConsts_SRegSetDataFailed,	"Failed to set data for '%s'"
+	RTLConsts_SResNotFound,	"Resource %s not found"
+	SysConst_SLongDayNameFri,	"Friday"
+	SysConst_SLongDayNameSat,	"Saturday"
+	RTLConsts_SAncestorNotFound,	"Ancestor for '%s' not found"
+	RTLConsts_SAssignError,	"Cannot assign a %s to a %s"
+	RTLConsts_SBitsIndexError,	"Bits index out of range"
+	RTLConsts_SCantWriteResourceStreamError,	"Can't write to a read-only resource stream"
+	RTLConsts_SCheckSynchronizeError,	"CheckSynchronize called from thread $%x, which is NOT the main thread"
+	RTLConsts_SClassNotFound,	"Class %s not found"
+	RTLConsts_SDuplicateClass,	"A class named %s already exists"
+	RTLConsts_SDuplicateItem,	"List does not allow duplicates ($0%x)"
+	RTLConsts_SDuplicateName,	"A component named %s already exists"
+	RTLConsts_SDuplicateString,	"String list does not allow duplicates"
+	RTLConsts_SFCreateErrorEx,	"Cannot create file \"%s\". %s"
+	RTLConsts_SFOpenErrorEx,	"Cannot open file \"%s\". %s"
+	RTLConsts_SIniFileWriteError,	"Unable to write to %s"
+	RTLConsts_SInvalidImage,	"Invalid stream format"
+	SysConst_SLongMonthNameSep,	"September"
+	SysConst_SLongMonthNameOct,	"October"
+	SysConst_SLongMonthNameNov,	"November"
+	SysConst_SLongMonthNameDec,	"December"
+	SysConst_SShortDayNameSun,	"Sun"
+	SysConst_SShortDayNameMon,	"Mon"
+	SysConst_SShortDayNameTue,	"Tue"
+	SysConst_SShortDayNameWed,	"Wed"
+	SysConst_SShortDayNameThu,	"Thu"
+	SysConst_SShortDayNameFri,	"Fri"
+	SysConst_SShortDayNameSat,	"Sat"
+	SysConst_SLongDayNameSun,	"Sunday"
+	SysConst_SLongDayNameMon,	"Monday"
+	SysConst_SLongDayNameTue,	"Tuesday"
+	SysConst_SLongDayNameWed,	"Wednesday"
+	SysConst_SLongDayNameThu,	"Thursday"
+	SysConst_SShortMonthNameMay,	"May"
+	SysConst_SShortMonthNameJun,	"Jun"
+	SysConst_SShortMonthNameJul,	"Jul"
+	SysConst_SShortMonthNameAug,	"Aug"
+	SysConst_SShortMonthNameSep,	"Sep"
+	SysConst_SShortMonthNameOct,	"Oct"
+	SysConst_SShortMonthNameNov,	"Nov"
+	SysConst_SShortMonthNameDec,	"Dec"
+	SysConst_SLongMonthNameJan,	"January"
+	SysConst_SLongMonthNameFeb,	"February"
+	SysConst_SLongMonthNameMar,	"March"
+	SysConst_SLongMonthNameApr,	"April"
+	SysConst_SLongMonthNameMay,	"May"
+	SysConst_SLongMonthNameJun,	"June"
+	SysConst_SLongMonthNameJul,	"July"
+	SysConst_SLongMonthNameAug,	"August"
+	SysConst_SVarBadType,	"Invalid variant type"
+	SysConst_SVarNotImplemented,	"Operation not supported"
+	SysConst_SVarUnexpected,	"Unexpected variant error"
+	SysConst_SExternalException,	"External exception %x"
+	SysConst_SAssertionFailed,	"Assertion failed"
+	SysConst_SIntfCastError,	"Interface not supported"
+	SysConst_SSafecallException,	"Exception in safecall method"
+	SysConst_SAssertError,	"%s (%s, line %d)"
+	SysConst_SAbstractError,	"Abstract Error"
+	SysConst_SModuleAccessViolation,	"Access violation at address %p in module '%s'. %s of address %p"
+	SysConst_SOSError,	"System Error.  Code: %d.\r\n%s"
+	SysConst_SUnkOSError,	"A call to an OS function failed"
+	SysConst_SShortMonthNameJan,	"Jan"
+	SysConst_SShortMonthNameFeb,	"Feb"
+	SysConst_SShortMonthNameMar,	"Mar"
+	SysConst_SShortMonthNameApr,	"Apr"
+	SysConst_SInvalidFormat,	"Format '%s' invalid or incompatible with argument"
+	SysConst_SArgumentMissing,	"No argument for format '%s'"
+	SysConst_SDispatchError,	"Variant method calls not supported"
+	SysConst_SReadAccess,	"Read"
+	SysConst_SWriteAccess,	"Write"
+	SysConst_SVarArrayCreate,	"Error creating variant or safe array"
+	SysConst_SVarArrayBounds,	"Variant or safe array index out of bounds"
+	SysConst_SVarArrayLocked,	"Variant or safe array is locked"
+	SysConst_SInvalidVarCast,	"Invalid variant type conversion"
+	SysConst_SInvalidVarOp,	"Invalid variant operation"
+	SysConst_SInvalidVarNullOp,	"Invalid NULL variant operation"
+	SysConst_SInvalidVarOpWithHResultWithPrefix,	"Invalid variant operation (%s%.8x)\n%s"
+	SysConst_SVarTypeCouldNotConvert,	"Could not convert variant of type (%s) into type (%s)"
+	SysConst_SVarTypeConvertOverflow,	"Overflow while converting variant of type (%s) into type (%s)"
+	SysConst_SVarOverflow,	"Variant overflow"
+	SysConst_SVarInvalid,	"Invalid argument"
+	SysConst_SDivByZero,	"Division by zero"
+	SysConst_SRangeError,	"Range check error"
+	SysConst_SIntOverflow,	"Integer overflow"
+	SysConst_SInvalidOp,	"Invalid floating point operation"
+	SysConst_SZeroDivide,	"Floating point division by zero"
+	SysConst_SOverflow,	"Floating point overflow"
+	SysConst_SUnderflow,	"Floating point underflow"
+	SysConst_SInvalidPointer,	"Invalid pointer operation"
+	SysConst_SInvalidCast,	"Invalid class typecast"
+	SysConst_SAccessViolationArg3,	"Access violation at address %p. %s of address %p"
+	SysConst_SAccessViolationNoArg,	"Access violation"
+	SysConst_SStackOverflow,	"Stack overflow"
+	SysConst_SControlC,	"Control-C hit"
+	SysConst_SPrivilege,	"Privileged instruction"
+	SysConst_SException,	"Exception %s in module %s at %p.\r\n%s%s\r\n"
+	SysConst_SExceptTitle,	"Application Error"
+	SysConst_SInvalidInteger,	"'%s' is not a valid integer value"
+	SysConst_SInvalidFloat,	"'%s' is not a valid floating point value"
+	SysConst_SInvalidDate,	"'%s' is not a valid date"
+	SysConst_SInvalidTime,	"'%s' is not a valid time"
+	SysConst_SInvalidDateTime,	"'%s' is not a valid date and time"
+	SysConst_STimeEncodeError,	"Invalid argument to time encode"
+	SysConst_SDateEncodeError,	"Invalid argument to date encode"
+	SysConst_SOutOfMemory,	"Out of memory"
+	SysConst_SInOutError,	"I/O error %d"
+	SysConst_SFileNotFound,	"File not found"
+	SysConst_SInvalidFilename,	"Invalid filename"
+	SysConst_STooManyOpenFiles,	"Too many open files"
+	SysConst_SAccessDenied,	"File access denied"
+	SysConst_SEndOfFile,	"Read beyond end of file"
+	SysConst_SDiskFull,	"Disk full"
+	SysConst_SInvalidInput,	"Invalid numeric input"
+END
+
+/* d:\soft\programming\delphi\lib\Controls.res */
+/* d:\soft\programming\delphi\lib\Buttons.res */
+/* d:\soft\programming\delphi\lib\ExtDlgs.res */
+/* d:\soft\programming\delphi\lib\GUITestRunner.DFM */
+/* D:\Soft\Programming\Delphi\source\SRC\Vfs\VfsTest.drf */

VfsUtils.pas

@@ -60,6 +60,7 @@ type
     procedure AddItem ({U} FileInfo: PNativeFileInfo; const FileName: WideString = ''; const InsertBefore: integer = High(integer));
     function  GetNextItem ({OUT} var {U} Res: TFileInfo): boolean;
     procedure Rewind;
+    procedure Clear;
 
     (* Always seeks as close as possible *)
     function Seek (SeekInd: integer): boolean;
@@ -97,6 +98,7 @@ type
     function IterNext ({OUT} var FileName: WideString; {n} FileInfo: WinNative.PFILE_ID_BOTH_DIR_INFORMATION = nil): boolean;
   end; // .class TSysDirScanner
 
+
 (* Packs lower cased WideString bytes into AnsiString buffer *)
 function WideStrToCaselessKey (const Str: WideString): string;
 
@@ -106,6 +108,10 @@ function CaselessKeyToWideStr (const CaselessKey: string): WideString;
 (* Returns expanded unicode path, preserving trailing delimiter, or original path on error *)
 function ExpandPath (const Path: WideString): WideString;
 
+(* Returns path without trailing delimiter (for non-drives). Optionally returns flag, whether path had trailing delim or not.
+   The flag is false for drives *)
+function NormalizeAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
+
 (* Returns expanded path without trailing delimiter (for non-drives). Optionally returns flag, whether path had trailing delim or not.
    The flag is false for drives *)
 function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
@@ -197,9 +203,9 @@ begin
   end; // .if
 end; // .function ExpandPath
 
-function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
+function NormalizeAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
 begin
-  result := StrLib.ExcludeTrailingDelimW(ExpandPath(Path), HadTrailingDelim);
+  result := StrLib.ExcludeTrailingDelimW(Path, HadTrailingDelim);
 
   if (Length(result) = 2) and (result[1] = ':') then begin
     result := result + '\';
@@ -210,6 +216,11 @@ begin
   end;
 end;
 
+function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
+begin
+  result := NormalizeAbsPath(ExpandPath(Path), HadTrailingDelim);
+end;
+
 function ToNtAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
 begin
   result := NormalizePath(Path, HadTrailingDelim);
@@ -340,6 +351,12 @@ begin
   Self.fFileInd := 0;
 end;
 
+procedure TDirListing.Clear;
+begin
+  Self.fFileList.Clear;
+  Self.fFileInd := 0;
+end;
+
 function TDirListing.Seek (SeekInd: integer): boolean;
 begin
   Self.fFileInd := Alg.ToRange(SeekInd, 0, Self.fFileList.Count - 1);
@@ -507,14 +524,11 @@ begin
       FileInfo.FileNameLength := FileNameLen * sizeof(WideChar);
     end;
 
-    //VarDump(['Read entry: ', FileName]);
-
     Self.fBufPos := Utils.IfThen(FileInfoInBuf.NextEntryOffset <> 0, Self.fBufPos + integer(FileInfoInBuf.NextEntryOffset), Self.BUF_SIZE);
   end else begin
     Self.fBufPos  := 0;
     Status        := WinNative.NtQueryDirectoryFile(Self.fDirHandle, 0, nil, nil, @IoStatusBlock, @Self.fBuf, Self.BUF_SIZE, ord(WinNative.FileIdBothDirectoryInformation), MULTIPLE_ENTRIES, @Self.fMaskU, Self.fIsStart);
     result        := (Status = WinNative.STATUS_SUCCESS) and (integer(IoStatusBlock.Information) <> 0);
-    //VarDump([Format('Called NtQueryDirectoryFile. Status: %x. Io.Information: %d', [Status, int(IoStatusBlock.Information)])]);
     Self.fIsStart := false;
 
     if result then begin