diff --git a/Tests/VfsControl.pas b/Tests/VfsControl.pas index 2df74da..c715ddf 100644 --- a/Tests/VfsControl.pas +++ b/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}; -var - AbsFilePath: WideString; - FileContents: string; - Lines: Utils.TArrayOfStr; - ModNameUtf8: string; - ModName: WideString; - i: integer; - -begin - result := DataLib.NewList(Utils.OWNS_ITEMS); - // * * * * * // - AbsFilePath := VfsUtils.NormalizePath(ModListFilePath); - - 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.Utf8ToWide(ModNameUtf8); - - if ValidateModName(ModName) then begin - result.Add(TWideString.Create(ModName)); - end; - end; - end; -end; // .function LoadModList - -// function MapModsDir (const RootDir, ModsDir: WideString; Flags: integer = 0); +// function LoadModList (const ModListFilePath: WideString; {O} var {out} ModList: DataLib.TList {of (O) TWideString}): boolean; // var -// AbsRootDir: WideString; -// AbsModsDir: WideString; -// FileInfo: VfsUtils.TNativeFileInfo; -// ModName: WideString; +// AbsFilePath: WideString; +// FileHandle: integer; +// FileContents: string; +// Lines: Utils.TArrayOfStr; +// ModNameUtf8: string; +// ModName: WideString; +// i: integer; +// // FIXME ModList is not result // 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; +// 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; +// end; // .function LoadModList + +function MapModsFromList_ (const RootDir, ModsDir: WideString; ModList: TList {of (O) TWideString}; Flags: integer = 0): boolean; +var + AbsRootDir: WideString; + AbsModsDir: WideString; + FileInfo: VfsUtils.TNativeFileInfo; + ModName: WideString; + ModPathPrefix: WideString; + NumFailedMappings: integer; + i: integer; + +begin + {!} Assert(ModList <> nil); + // * * * * * // + 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 + ModPathPrefix := VfsUtils.AddBackslash(AbsModsDir); + NumFailedMappings := 0; + + for i := ModList.Count - 1 downto 0 do begin + ModName := TWideString(ModList[i]).Value; + + if not VfsBase.MapDir(AbsRootDir, ModPathPrefix + ModName, not VfsBase.OVERWRITE_EXISTING, Flags) then begin + 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; 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. \ No newline at end of file diff --git a/Tests/VfsIntegratedTest.pas b/Tests/VfsIntegratedTest.pas index fa0113b..170f965 100644 --- a/Tests/VfsIntegratedTest.pas +++ b/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'); diff --git a/VfsBase.pas b/VfsBase.pas index 16978d9..d62cd3d 100644 --- a/VfsBase.pas +++ b/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 - Enter; - - result := not VfsIsRunning and not VfsTreeIsBuilt; + result := EnterVfsConfig; - if result then begin - result := _MapDir(NormalizePath(VirtPath), NormalizePath(RealPath), nil, OverwriteExisting, AUTO_PRIORITY) <> nil; - end; - - Leave; + if result then begin + result := _MapDir(NormalizePath(VirtPath), NormalizePath(RealPath), nil, OverwriteExisting, AUTO_PRIORITY) <> nil; + LeaveVfsConfig; end; end; diff --git a/VfsHooks.pas b/VfsHooks.pas index 215126f..f6219cc 100644 --- a/VfsHooks.pas +++ b/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; diff --git a/VfsOpenFiles.pas b/VfsOpenFiles.pas index 586ac73..cf41840 100644 --- a/VfsOpenFiles.pas +++ b/VfsOpenFiles.pas @@ -108,8 +108,12 @@ begin with VfsBase.GetThreadVfsDisabler do begin DisableVfsForThread; - VfsUtils.GetDirectoryListing(Self.AbsPath, Mask, ExcludedItems, Self.DirListing); - RestoreVfsForThread; + + 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 diff --git a/VfsUtils.pas b/VfsUtils.pas index 12209c4..85a04c2 100644 --- a/VfsUtils.pas +++ b/VfsUtils.pas @@ -8,8 +8,9 @@ unit VfsUtils; uses SysUtils, Math, Windows, - Utils, WinNative, Alg, TypeWrappers, Lists, DataLib, - StrLib; + Utils, WinNative, Alg, TypeWrappers, + 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 (***) @@ -634,19 +637,20 @@ end; procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing); var -{O} Items: {O} TList {OF TDirListingItem}; -{O} Item: {O} TDirListingItem; - i: integer; +{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; + 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;