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

This commit is contained in:
Berserker 2019-05-08 23:17:55 +03:00
parent 21c4b1df1c
commit c2c2c83cf6
14 changed files with 15376 additions and 65 deletions

View File

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

View File

@ -4,15 +4,14 @@ unit VfsIntegratedTest;
uses uses
SysUtils, TestFramework, Windows, SysUtils, TestFramework, Windows,
Utils, WinUtils, ConsoleApi, Files, Utils, WinUtils, ConsoleApi, Files, FilesEx,
DataLib,
VfsUtils, VfsBase, VfsDebug, VfsUtils, VfsBase, VfsDebug,
VfsOpenFiles, VfsControl, DlgMes; VfsOpenFiles, VfsControl, DlgMes;
type type
TestIntegrated = class (TTestCase) TestIntegrated = class (TTestCase)
private private
Inited: boolean;
function GetRootDir: string; function GetRootDir: string;
protected protected
@ -23,6 +22,7 @@ type
procedure TestGetFileAttributes; procedure TestGetFileAttributes;
procedure TestGetFileAttributesEx; procedure TestGetFileAttributesEx;
procedure TestFilesOpenClose; procedure TestFilesOpenClose;
procedure TestDirectoryListing;
end; end;
@ -164,6 +164,83 @@ begin
end; // .try end; // .try
end; // .procedure TestIntegrated.TestFilesOpenClose; 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 begin
RegisterTest(TestIntegrated.Suite); RegisterTest(TestIntegrated.Suite);
end. end.

35
Tests/VfsMatchingTest.pas Normal file
View File

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

View File

@ -35,6 +35,7 @@ procedure TestOpenFiles.GetCombinedDirListing;
const 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 var
{O} OpenedFile: VfsOpenFiles.TOpenedFile; {O} OpenedFile: VfsOpenFiles.TOpenedFile;
@ -53,13 +54,20 @@ begin
OpenedFile := VfsOpenFiles.TOpenedFile.Create(777, DirPath); OpenedFile := VfsOpenFiles.TOpenedFile.Create(777, DirPath);
OpenedFile.FillDirListing('*'); OpenedFile.FillDirListing('*');
Check(OpenedFile.DirListing <> nil, 'Directory listing must be assigned'); 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); FreeAndNil(OpenedFile);
OpenedFile := VfsOpenFiles.TOpenedFile.Create(888, RootDir); OpenedFile := VfsOpenFiles.TOpenedFile.Create(888, RootDir);
OpenedFile.FillDirListing('*'); OpenedFile.FillDirListing('*');
Check(OpenedFile.DirListing <> nil, 'Directory listing must be assigned'); 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); SysUtils.FreeAndNil(OpenedFile);
end; end;

10
Vfs.dpr
View File

@ -5,14 +5,6 @@ library Vfs;
uses Windows; uses Windows;
procedure DLLEntryPoint (Reason: DWORD);
begin 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. end.

View File

@ -12,7 +12,7 @@ uses
SysUtils, Math, Windows, SysUtils, Math, Windows,
Utils, WinNative, Alg, Concur, TypeWrappers, Lists, DataLib, Utils, WinNative, Alg, Concur, TypeWrappers, Lists, DataLib,
StrLib, StrLib,
VfsUtils; VfsUtils, VfsMatching;
type type
(* Import *) (* Import *)
@ -98,6 +98,9 @@ function PauseVfs: boolean;
(* Stops VFS and clears all mappings *) (* Stops VFS and clears all mappings *)
function ResetVfs: boolean; 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 *) (* 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; function GetVfsItemRealPath (const AbsVirtPath: WideString; {n} FileInfo: PNativeFileInfo = nil): WideString;
@ -325,6 +328,12 @@ begin
end; end;
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 *) (* 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; function GetVfsItemRealPath (const AbsVirtPath: WideString; {n} FileInfo: PNativeFileInfo = nil): WideString;
var var
@ -351,6 +360,7 @@ function GetVfsDirInfo (const AbsVirtPath, Mask: WideString; {OUT} var DirInfo:
var var
{n} VfsItem: TVfsItem; {n} VfsItem: TVfsItem;
NormalizedMask: WideString; NormalizedMask: WideString;
MaskPattern: Utils.TArrayOfByte;
i: integer; i: integer;
begin begin
@ -367,9 +377,10 @@ begin
if VfsItem.Children <> nil then begin if VfsItem.Children <> nil then begin
NormalizedMask := StrLib.WideLowerCase(Mask); NormalizedMask := StrLib.WideLowerCase(Mask);
MaskPattern := VfsMatching.CompilePattern(NormalizedMask);
for i := 0 to VfsItem.Children.Count - 1 do begin 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); DirListing.AddItem(@TVfsItem(VfsItem.Children[i]).Info);
end; end;
end; end;

View File

@ -252,7 +252,7 @@ begin
result := OrigFunc(FileHandle, DesiredAccess, @ReplacedObjAttrs, IoStatusBlock, AllocationSize, FileAttributes, ShareAccess, CreateDisposition, CreateOptions, EaBuffer, EaLength); result := OrigFunc(FileHandle, DesiredAccess, @ReplacedObjAttrs, IoStatusBlock, AllocationSize, FileAttributes, ShareAccess, CreateDisposition, CreateOptions, EaBuffer, EaLength);
if (result = WinNative.STATUS_SUCCESS) and (ExpandedPath <> '') then begin 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; end;
Leave; Leave;
@ -375,6 +375,7 @@ var
StructConvertResult: TFileInfoConvertResult; StructConvertResult: TFileInfoConvertResult;
EmptyMask: UNICODE_STRING; EmptyMask: UNICODE_STRING;
EntryName: WideString; EntryName: WideString;
VfsIsActive: boolean;
begin begin
OpenedFile := nil; OpenedFile := nil;
@ -383,23 +384,24 @@ begin
PrevEntry := nil; PrevEntry := nil;
BufSize := 0; BufSize := 0;
// * * * * * // // * * * * * //
with OpenFilesCritSection do begin with VfsOpenFiles.OpenFilesCritSection do begin
if Mask = nil then begin if Mask = nil then begin
EmptyMask.Reset; EmptyMask.Reset;
Mask := @EmptyMask; Mask := @EmptyMask;
end; end;
if VfsDebug.LoggingEnabled then begin 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; end;
Enter; 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); result := OrigFunc(FileHandle, Event, ApcRoutine, ApcContext, Io, Buffer, BufLength, InfoClass, SingleEntry, Mask, RestartScan);
end else begin end else begin
int(Io.Information) := 0; int(Io.Information) := 0;
@ -434,12 +436,20 @@ begin
Proceed := not OpenedFile.DirListing.IsEnd; Proceed := not OpenedFile.DirListing.IsEnd;
if not Proceed then begin if not Proceed then begin
if OpenedFile.DirListing.Count > 0 then begin
result := STATUS_NO_MORE_FILES; result := STATUS_NO_MORE_FILES;
end else begin
result := STATUS_NO_SUCH_FILE;
end;
end; end;
end; end;
// Scan directory // Scan directory
if Proceed then begin 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; BufCurret := Buffer;
BytesWritten := 1; BytesWritten := 1;
@ -460,11 +470,9 @@ begin
if VfsDebug.LoggingEnabled then begin if VfsDebug.LoggingEnabled then begin
EntryName := Copy(FileInfo.Data.FileName, 1, Min(BytesWritten - WinNative.GetFileInformationClassSize(InfoClass), FileInfo.Data.Base.FileNameLength) div 2); 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; 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 with PFILE_ID_BOTH_DIR_INFORMATION(BufCurret)^ do begin
NextEntryOffset := 0; NextEntryOffset := 0;
FileIndex := 0; FileIndex := 0;
@ -497,8 +505,6 @@ begin
PrevEntry := BufCurret; PrevEntry := BufCurret;
//Msg(Format('Written: %d. Total: %d', [BytesWritten, int(Io.Information)]));
if SingleEntry then begin if SingleEntry then begin
BytesWritten := 0; BytesWritten := 0;
end; end;
@ -506,18 +512,19 @@ begin
end; // .if end; // .if
Io.Status.Status := result; Io.Status.Status := result;
end; // .else
Leave; Leave;
end; // .else
end; // .with end; // .with
if VfsDebug.LoggingEnabled then begin 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;
end; // .function Hook_NtQueryDirectoryFile end; // .function Hook_NtQueryDirectoryFile
procedure InstallHooks; procedure InstallHooks;
var var
SetProcessDEPPolicy: function (dwFlags: integer): LONGBOOL; stdcall;
hDll: Windows.THandle; hDll: Windows.THandle;
NtdllHandle: integer; NtdllHandle: integer;
@ -528,6 +535,17 @@ begin
if not HooksInstalled then begin if not HooksInstalled then begin
HooksInstalled := true; 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 // Ensure, that library with VFS hooks installed is never unloaded
if System.IsLibrary then begin 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); 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 @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 end; // .if
Leave; Leave;
@ -598,6 +616,7 @@ begin
NtOpenFilePatch.Rollback; NtOpenFilePatch.Rollback;
NtCreateFilePatch.Rollback; NtCreateFilePatch.Rollback;
NtClosePatch.Rollback; NtClosePatch.Rollback;
NtQueryDirectoryFilePatch.Rollback;
Leave; Leave;
end; end;

276
VfsMatching.pas Normal file
View File

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

View File

@ -14,7 +14,7 @@ unit VfsOpenFiles;
uses uses
Windows, SysUtils, Windows, SysUtils,
Utils, Concur, DataLib, StrLib, Utils, Concur, DataLib, StrLib,
VfsUtils, VfsBase; VfsUtils, VfsBase, VfsMatching;
type type
(* Import *) (* Import *)
@ -44,6 +44,9 @@ var
OpenFilesCritSection: Concur.TCritSection; 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 *) (* 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; function GetOpenedFilePath (hFile: Windows.THandle): WideString;
@ -81,7 +84,6 @@ var
DirInfo: TNativeFileInfo; DirInfo: TNativeFileInfo;
ParentDirInfo: TNativeFileInfo; ParentDirInfo: TNativeFileInfo;
DirItem: TFileInfo; DirItem: TFileInfo;
i: integer;
begin begin
ExcludedItems := nil; ExcludedItems := nil;
@ -113,11 +115,11 @@ begin
// No real items added, maybe there is a need to add '.' and/or '..' manually // No real items added, maybe there is a need to add '.' and/or '..' manually
if VfsItemFound and (Self.DirListing.Count = NumVfsChildren) then begin 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, '.'); Self.DirListing.AddItem(@DirInfo, '.');
end; 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, '..'); Self.DirListing.AddItem(@ParentDirInfo, '..');
end; end;
end; end;
@ -125,6 +127,11 @@ begin
SysUtils.FreeAndNil(ExcludedItems); SysUtils.FreeAndNil(ExcludedItems);
end; // .procedure TOpenedFile.FillDirListing end; // .procedure TOpenedFile.FillDirListing
function GetOpenedFile (hFile: Windows.THandle): {n} TOpenedFile;
begin
result := OpenedFiles[pointer(hFile)];
end;
function GetOpenedFilePath (hFile: Windows.THandle): WideString; function GetOpenedFilePath (hFile: Windows.THandle): WideString;
var var
{n} OpenedFile: TOpenedFile; {n} OpenedFile: TOpenedFile;

View File

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

View File

@ -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> <PropertyGroup>
<ProjectGuid>{c6015c7b-4070-47b6-8c8a-c2b54aba82d6}</ProjectGuid> <ProjectGuid>{c6015c7b-4070-47b6-8c8a-c2b54aba82d6}</ProjectGuid>
<MainSource>VfsTest.dpr</MainSource> <MainSource>VfsTest.dpr</MainSource>
@ -22,6 +23,8 @@
<DCC_ResourcePath>..\Lib\B2;.\Tests</DCC_ResourcePath> <DCC_ResourcePath>..\Lib\B2;.\Tests</DCC_ResourcePath>
<DCC_ObjPath>..\Lib\B2;.\Tests</DCC_ObjPath> <DCC_ObjPath>..\Lib\B2;.\Tests</DCC_ObjPath>
<DCC_IncludePath>..\Lib\B2;.\Tests</DCC_IncludePath> <DCC_IncludePath>..\Lib\B2;.\Tests</DCC_IncludePath>
<DCC_MapFile>3</DCC_MapFile>
<DCC_Optimize>False</DCC_Optimize>
</PropertyGroup> </PropertyGroup>
<ProjectExtensions> <ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality> <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\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 Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject> </Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject>

503
VfsTest.drc Normal file
View File

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

14325
VfsTest.map Normal file

File diff suppressed because it is too large Load Diff

View File

@ -60,6 +60,7 @@ type
procedure AddItem ({U} FileInfo: PNativeFileInfo; const FileName: WideString = ''; const InsertBefore: integer = High(integer)); procedure AddItem ({U} FileInfo: PNativeFileInfo; const FileName: WideString = ''; const InsertBefore: integer = High(integer));
function GetNextItem ({OUT} var {U} Res: TFileInfo): boolean; function GetNextItem ({OUT} var {U} Res: TFileInfo): boolean;
procedure Rewind; procedure Rewind;
procedure Clear;
(* Always seeks as close as possible *) (* Always seeks as close as possible *)
function Seek (SeekInd: integer): boolean; 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; function IterNext ({OUT} var FileName: WideString; {n} FileInfo: WinNative.PFILE_ID_BOTH_DIR_INFORMATION = nil): boolean;
end; // .class TSysDirScanner end; // .class TSysDirScanner
(* Packs lower cased WideString bytes into AnsiString buffer *) (* Packs lower cased WideString bytes into AnsiString buffer *)
function WideStrToCaselessKey (const Str: WideString): string; 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 *) (* Returns expanded unicode path, preserving trailing delimiter, or original path on error *)
function ExpandPath (const Path: WideString): WideString; 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. (* 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 *) The flag is false for drives *)
function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString; function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
@ -197,9 +203,9 @@ begin
end; // .if end; // .if
end; // .function ExpandPath end; // .function ExpandPath
function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString; function NormalizeAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
begin begin
result := StrLib.ExcludeTrailingDelimW(ExpandPath(Path), HadTrailingDelim); result := StrLib.ExcludeTrailingDelimW(Path, HadTrailingDelim);
if (Length(result) = 2) and (result[1] = ':') then begin if (Length(result) = 2) and (result[1] = ':') then begin
result := result + '\'; result := result + '\';
@ -210,6 +216,11 @@ begin
end; end;
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; function ToNtAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
begin begin
result := NormalizePath(Path, HadTrailingDelim); result := NormalizePath(Path, HadTrailingDelim);
@ -340,6 +351,12 @@ begin
Self.fFileInd := 0; Self.fFileInd := 0;
end; end;
procedure TDirListing.Clear;
begin
Self.fFileList.Clear;
Self.fFileInd := 0;
end;
function TDirListing.Seek (SeekInd: integer): boolean; function TDirListing.Seek (SeekInd: integer): boolean;
begin begin
Self.fFileInd := Alg.ToRange(SeekInd, 0, Self.fFileList.Count - 1); Self.fFileInd := Alg.ToRange(SeekInd, 0, Self.fFileList.Count - 1);
@ -507,14 +524,11 @@ begin
FileInfo.FileNameLength := FileNameLen * sizeof(WideChar); FileInfo.FileNameLength := FileNameLen * sizeof(WideChar);
end; end;
//VarDump(['Read entry: ', FileName]);
Self.fBufPos := Utils.IfThen(FileInfoInBuf.NextEntryOffset <> 0, Self.fBufPos + integer(FileInfoInBuf.NextEntryOffset), Self.BUF_SIZE); Self.fBufPos := Utils.IfThen(FileInfoInBuf.NextEntryOffset <> 0, Self.fBufPos + integer(FileInfoInBuf.NextEntryOffset), Self.BUF_SIZE);
end else begin end else begin
Self.fBufPos := 0; 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); 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); 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; Self.fIsStart := false;
if result then begin if result then begin