git_admin/Virtual-File-System
1
0
Fork 0
mirror of https://github.com/CloudDelphi/Virtual-File-System synced 2025-12-19 09:53:54 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Berserker 2019-05-12 00:51:15 +03:00
parent ff8192c149
commit 4fbc7cddd0
6 changed files with 116 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
Tests/VfsControl.pas
View File

@ -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.

3
Tests/VfsIntegratedTest.pas
View File

@ -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');

28
VfsBase.pas
View File

@ -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;

6
VfsHooks.pas
View File

@ -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;

8
VfsOpenFiles.pas
View File

@ -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

24
VfsUtils.pas
View File

@ -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;