Testing in battle mode. Struggling with crashes

Tests/VfsIntegratedTest.pas

@@ -56,7 +56,7 @@ begin
   VfsBase.MapDir(RootDir, VfsUtils.MakePath([RootDir, 'Mods\Apache']), DONT_OVERWRITE_EXISTING);
   VfsDebug.SetLoggingProc(LogSomething);
   VfsControl.RunVfs(VfsBase.SORT_FIFO);
-  Windows.MessageBoxA(0, '', '', 0);
+  //Windows.MessageBoxA(0, '', '', 0); FIXME DELETEME
 end;
 
 procedure TestIntegrated.TearDown;

VfsExport.pas

@@ -43,11 +43,46 @@ begin
   result := VfsControl.MapModsFromList(WideString(RootDir), WideString(ModsDir), WideString(ModListFile), Flags);
 end;
 
+procedure ConsoleLoggingProc (Operation, Message: pchar); stdcall;
+begin
+  WriteLn('>> ', string(Operation), ': ', string(Message), #13#10);
+end;
+
+(* Allocates console and install logger, writing messages to console *)
+procedure InstallConsoleLogger; stdcall;
+var
+  Rect:    TSmallRect;
+  BufSize: TCoord;
+  hIn:     THandle;
+  hOut:    THandle;
+
+begin
+  AllocConsole;
+  SetConsoleCP(GetACP);
+  SetConsoleOutputCP(GetACP);
+  hIn                       := GetStdHandle(STD_INPUT_HANDLE);
+  hOut                      := GetStdHandle(STD_OUTPUT_HANDLE);
+  pinteger(@System.Input)^  := hIn;
+  pinteger(@System.Output)^ := hOut;
+  BufSize.x                 := 120;
+  BufSize.y                 := 1000;
+  SetConsoleScreenBufferSize(hOut, BufSize);
+  Rect.Left                 := 0;
+  Rect.Top                  := 0;
+  Rect.Right                := 120 - 1;
+  Rect.Bottom               := 50 - 1;
+  SetConsoleWindowInfo(hOut, true, Rect);
+  SetConsoleTextAttribute(hOut, (0 shl 4) or $0F);
+
+  VfsDebug.SetLoggingProc(@ConsoleLoggingProc);
+end; // .procedure InitConsole;
+
 exports
   MapDir,
   MapDirA,
   MapModsFromList,
-  MapModsFromListA;
+  MapModsFromListA,
+  InstallConsoleLogger;
 
 // var s: string;
 // begin

VfsHooks.pas

@@ -11,7 +11,8 @@ uses
   Utils, WinNative, Concur,
   StrLib, Alg,
   VfsBase, VfsUtils, VfsPatching,
-  VfsDebug, VfsApiDigger, VfsOpenFiles;
+  VfsDebug, VfsApiDigger, VfsOpenFiles,
+  {FIXME DELETEME} DlgMes;
 
 
 (* Installs VFS hooks, if not already installed, in a thread-safe manner *)
@@ -278,9 +279,9 @@ end; // .function Hook_NtCreateFile
 
 function Hook_NtClose (OrigFunc: WinNative.TNtClose; hData: HANDLE): NTSTATUS; stdcall;
 begin
-  if VfsDebug.LoggingEnabled then begin
+  // if VfsDebug.LoggingEnabled then begin
-    WriteLog('[ENTER] NtClose', Format('Handle: %x', [integer(hData)]));
+  //   WriteLog('[ENTER] NtClose', Format('Handle: %x', [integer(hData)]));
-  end;
+  // end;
 
   with VfsOpenFiles.OpenFilesCritSection do begin
     Enter;
@@ -294,9 +295,9 @@ begin
     Leave;
   end;
   
-  if VfsDebug.LoggingEnabled then begin
+  // if VfsDebug.LoggingEnabled then begin
-    WriteLog('[LEAVE] NtClose', Format('Status: %x', [integer(result)]));
+  //   WriteLog('[LEAVE] NtClose', Format('Status: %x', [integer(result)]));
-  end;
+  // end;  
 end; // .function Hook_NtClose
 
 function IsSupportedFileInformationClass (FileInformationClass: integer): boolean;
@@ -358,6 +359,9 @@ begin
   BytesWritten := StructBaseSize + FileNameBufSize;
 end; // .function ConvertFileInfoStruct
 
+const
+  MASK_ALL_FILES: WideString = '*'#0;
+
 function Hook_NtQueryDirectoryFile (OrigFunc: WinNative.TNtQueryDirectoryFile; FileHandle: HANDLE; Event: HANDLE; ApcRoutine: pointer; ApcContext: PVOID; Io: PIO_STATUS_BLOCK; Buffer: PVOID;
                                     BufLength: ULONG; InfoClass: integer (* FILE_INFORMATION_CLASS *); SingleEntry: BOOLEAN; {n} Mask: PUNICODE_STRING; RestartScan: BOOLEAN): NTSTATUS; stdcall;
 const
@@ -373,7 +377,7 @@ type
 var
 {Un} OpenedFile:             TOpenedFile;
 {Un} FileInfo:               TFileInfo;
-{n}  BufCurret:              pointer;
+{n}  BufCaret:               pointer;
 {n}  PrevEntry:              PPrevEntry;
      BufSize:                integer;
      BufSizeLeft:            integer;
@@ -389,16 +393,11 @@ var
 begin
   OpenedFile := nil;
   FileInfo   := nil;
-  BufCurret  := nil;
+  BufCaret   := nil;
   PrevEntry  := nil;
-  BufSize    := 0;
+  BufSize    := BufLength;
   // * * * * * //
   with VfsOpenFiles.OpenFilesCritSection do begin
-    if Mask = nil then begin
-      EmptyMask.Reset;
-      Mask := @EmptyMask;
-    end;
-
     if VfsDebug.LoggingEnabled then begin
       WriteLog('[ENTER] NtQueryDirectoryFile', Format('Handle: %x. InfoClass: %s. Mask: %s. SingleEntry: %d', [Int(FileHandle), WinNative.FileInformationClassToStr(InfoClass), string(Mask.ToWideStr()), ord(SingleEntry)]));
     end;
@@ -408,48 +407,56 @@ begin
     OpenedFile  := VfsOpenFiles.GetOpenedFile(FileHandle);
     VfsIsActive := VfsBase.IsVfsActive;
 
-    if (OpenedFile = nil) or (Event <> 0) or (ApcRoutine <> nil) or (ApcContext <> nil) or (not VfsIsActive) then begin
+    if RestartScan then begin
+      SysUtils.FreeAndNil(OpenedFile.DirListing);
+    end;
+
+    if (OpenedFile = nil) or (not IsSupportedFileInformationClass(InfoClass) and (OpenedFile.DirListing = nil)) or (Event <> 0) or (ApcRoutine <> nil) or (ApcContext <> nil) or (not VfsIsActive) then begin
       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;
       result              := STATUS_SUCCESS;
+      Proceed             := true;
 
-      if RestartScan then begin
+      // Disallow nil buffer
-        SysUtils.FreeAndNil(OpenedFile.DirListing);
+      if Proceed and (Buffer = nil) then begin
+        Proceed := false;
+        result  := STATUS_ACCESS_VIOLATION;
       end;
 
-      OpenedFile.FillDirListing(Mask.ToWideStr());
+      // Validate buffer size
-
+      if Proceed and (int(BufLength) < WinNative.GetFileInformationClassSize(InfoClass)) then begin
-      Proceed := (Buffer <> nil) and (BufLength > 0);
+        Proceed := false;
-
+        result  := STATUS_INFO_LENGTH_MISMATCH;
-      // Validate buffer
-      if not Proceed then begin
-        result := STATUS_INVALID_BUFFER_SIZE;
-      end else begin
-        BufSize := Utils.IfThen(int(BufLength) > 0, int(BufLength), High(int));
       end;
   
       // Validate information class
-      if Proceed then begin
+      if Proceed and not IsSupportedFileInformationClass(InfoClass) then begin
-        Proceed := IsSupportedFileInformationClass(InfoClass);
+        Proceed := false;
+        result  := STATUS_INVALID_INFO_CLASS;
+      end;
 
-        if not Proceed then begin
+      // Fill internal listing
-          result := STATUS_INVALID_INFO_CLASS;
+      if OpenedFile.DirListing = nil then begin
+        // NIL mask must treated as *
+        if Mask = nil then begin
+          EmptyMask.AssignExistingStr(MASK_ALL_FILES);
+          Mask := @EmptyMask;
         end;
+
+        OpenedFile.FillDirListing(Mask.ToWideStr());
       end;
 
       // Signal of scanning end, if necessary
-      if Proceed then begin
+      if Proceed and OpenedFile.DirListing.IsEnd then begin
-        Proceed := not OpenedFile.DirListing.IsEnd;
+        Proceed := false;
 
-        if not Proceed then begin
+        if OpenedFile.DirListing.Count > 0 then begin
-          if OpenedFile.DirListing.Count > 0 then begin
+          result := STATUS_NO_MORE_FILES;
-            result := STATUS_NO_MORE_FILES;
+        end else begin
-          end else begin
+          result := STATUS_NO_SUCH_FILE;
-            result := STATUS_NO_SUCH_FILE;
-          end;
         end;
       end;
 
@@ -459,13 +466,13 @@ begin
           WriteLog('[INNER] NtQueryDirectoryFile', Format('Writing entries for buffer of size %d. Single entry: %d', [BufSize, ord(SingleEntry)]));
         end;
 
-        BufCurret    := Buffer;
+        BufCaret     := Buffer;
         BytesWritten := 1;
 
         while (BytesWritten > 0) and OpenedFile.DirListing.GetNextItem(FileInfo) do begin
           // Align next record to 8-bytes boundary from Buffer start
-          BufCurret   := pointer(int(Buffer) + Alg.IntRoundToBoundary(int(Io.Information), ENTRIES_ALIGNMENT));
+          BufCaret    := pointer(int(Buffer) + Alg.IntRoundToBoundary(int(Io.Information), ENTRIES_ALIGNMENT));
-          BufSizeLeft := BufSize - (int(BufCurret) - int(Buffer));
+          BufSizeLeft := BufSize - (int(BufCaret) - int(Buffer));
 
           IsFirstEntry := OpenedFile.DirListing.FileInd = 1;
 
@@ -475,14 +482,14 @@ begin
             TruncatedNamesStrategy := DONT_TRUNCATE_NAMES;
           end;
 
-          StructConvertResult := ConvertFileInfoStruct(@FileInfo.Data, FILE_INFORMATION_CLASS(byte(InfoClass)), BufCurret, BufSizeLeft, TruncatedNamesStrategy, BytesWritten);
+          StructConvertResult := ConvertFileInfoStruct(@FileInfo.Data, FILE_INFORMATION_CLASS(byte(InfoClass)), BufCaret, BufSizeLeft, TruncatedNamesStrategy, BytesWritten);
 
           if VfsDebug.LoggingEnabled then begin
             EntryName := Copy(FileInfo.Data.FileName, 1, Min(BytesWritten - WinNative.GetFileInformationClassSize(InfoClass), FileInfo.Data.Base.FileNameLength) div 2);
             WriteLog('[INNER] NtQueryDirectoryFile', 'Written entry: ' + EntryName);
           end;
 
-          with PFILE_ID_BOTH_DIR_INFORMATION(BufCurret)^ do begin
+          with PFILE_ID_BOTH_DIR_INFORMATION(BufCaret)^ do begin
             NextEntryOffset := 0;
             FileIndex       := 0;
           end;
@@ -491,7 +498,8 @@ begin
             OpenedFile.DirListing.SeekRel(-1);
 
             if IsFirstEntry then begin
-              result := STATUS_BUFFER_TOO_SMALL;
+              result := STATUS_INFO_LENGTH_MISMATCH;
+              VarDump([BufLength, WinNative.GetFileInformationClassSize(InfoClass), BytesWritten, '---', Buffer, BufCaret, BufSize]);
             end;            
           end else if StructConvertResult = TRUNCATED_NAME then begin
             if IsFirstEntry then begin
@@ -502,17 +510,17 @@ begin
             end;
           end else if StructConvertResult = COPIED_ALL then begin
             if PrevEntry <> nil then begin
-              int(Io.Information) := int(BufCurret) - int(Buffer) + BytesWritten;
+              int(Io.Information) := int(BufCaret) - int(Buffer) + BytesWritten;
             end else begin
               int(Io.Information) := BytesWritten;
             end;
           end; // .else
 
           if (BytesWritten > 0) and (PrevEntry <> nil) then begin
-            PrevEntry.NextEntryOffset := cardinal(int(BufCurret) - int(PrevEntry));
+            PrevEntry.NextEntryOffset := cardinal(int(BufCaret) - int(PrevEntry));
           end;
 
-          PrevEntry := BufCurret;
+          PrevEntry := BufCaret;
 
           if SingleEntry then begin
             BytesWritten := 0;

VfsImport.pas

@@ -0,0 +1,37 @@
+unit VfsImport;
+(*
+  
+*)
+
+
+(***)  interface  (***)
+
+uses
+  SysUtils, Utils;
+
+type
+  (*
+    Specifies the order, in which files from different mapped directories will be listed in virtual directory.
+    Virtual directory sorting is performed by priorities firstly and lexicographically secondly.
+    SORT_FIFO - Items of the first mapped directory will be listed before the second mapped directory items.
+    SORT_LIFO - Items of The last mapped directory will be listed before all other mapped directory items.
+  *)
+  TDirListingSortType = (SORT_FIFO = 0, SORT_LIFO = 1);
+
+(* Loads mod list from file and maps each mod directory to specified root directory.
+   File with mod list is treated as (BOM or BOM-less) UTF-8 plain text file, where each mod name is separated
+   from another one via Line Feed (#10) character. Each mod named is trimmed, converted to UCS16 and validated before
+   adding to list. Invalid or empty mods will be skipped. Mods are mapped in reverse order, as compared to their order in file.
+   Returns true if root and mods directory existed and file with mod list was loaded successfully *)
+function MapModsFromList (const RootDir, ModsDir, ModListFile: PWideChar; Flags: integer = 0): LONGBOOL; stdcall; external 'vfs.dll';
+
+(* Runs all VFS subsystems, unless VFS is already running *)
+function RunVfs (DirListingOrder: TDirListingSortType): LONGBOOL; stdcall; external 'vfs.dll';
+
+(* Allocates console and install logger, writing messages to console *)
+procedure InstallConsoleLogger; stdcall; external 'vfs.dll';
+
+(***)  implementation  (***)
+
+
+end.

VfsWatching.pas

@@ -348,8 +348,8 @@ var
   DirChange: TDirChange;
 
 begin
-  WatcherCritSection.Init;
+  // WatcherCritSection.Init;
-  RunWatcher(GetCurrentDir + '\Tests\', 250);
+  // RunWatcher(GetCurrentDir + '\Tests\', 250);
 
   // with ReadDirChanges('D:') do begin
   //   while IterNext(DirChange, 0) do begin

_update_dll.bat

@@ -0,0 +1,13 @@
+@echo off
+:start
+cls
+set h3dir=D:\Heroes 3
+copy /Y Vfs.dll "%h3dir%\vfs.dll"
+copy /Y Vfs.map "%h3dir%\Vfs.map"
+php "%h3dir%\Tools\ExeMapCompiler\compile.phc" "vfs.map" "./DebugMaps"
+echo.
+echo.
+echo %date% %time%
+echo.
+pause
+goto start