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

Added live vfs watching/reloading support in debug mode

Browse Source
This commit is contained in:
Berserker 2019-05-23 00:31:42 +03:00
parent 081194c185
commit 9e2c531428
6 changed files with 544 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Tests/VfsIntegratedTest.pas
View File

@ -56,6 +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);
end;
procedure TestIntegrated.TearDown;

149
VfsBase.pas
View File

@ -76,6 +76,7 @@ type
PrevDisableVfsForThisThread: boolean;
procedure DisableVfsForThread;
procedure EnableVfsForThread;
procedure RestoreVfsForThread;
end;
@ -98,6 +99,13 @@ function PauseVfs: LONGBOOL; stdcall;
(* Stops VFS and clears all mappings *)
function ResetVfs: LONGBOOL; stdcall;
(* If VFS is running or paused, pauses VFS, clears cache and fully reaplies all mappings in the same order and
with the same arguments, as MapDir routines were called earlier. Restores VFS state afterwards *)
function RefreshVfs: LONGBOOL; stdcall;
(* Refreshes VFS item attributes info for given mapped file. File must exist to succeed *)
function RefreshMappedFile (const FilePath: WideString): boolean;
(* Returns true if VFS is active globally and for current thread *)
function IsVfsActive: boolean;
@ -122,17 +130,37 @@ function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): inte
(***) implementation (***)
type
(* Applied and remembered mapping. Used to refresh or report VFS *)
TMapping = class
AbsVirtPath: WideString;
AbsRealPath: WideString;
OverwriteExisting: boolean;
Flags: integer;
class function Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): TMapping;
end;
var
(*
Global map of case-insensitive normalized path to file/directory => corresponding TVfsItem.
Access is controlled via critical section and global/thread switchers.
Represents the whole cached virtual file system contents.
*)
{O} VfsItems: {O} TDict {OF TVfsItem};
{O} VfsItems: {O} TDict {of TVfsItem};
(* Map of real (mapped) file path => VFS item. Used to update VFS info whenever mapped files are changed *)
{O} MappedFiles: {U} TDict {of TVfsItem};
(* List of all applied mappings *)
{O} Mappings: {O} TList {of TMapping};
(* Global VFS state indicator. If false, all VFS search operations must fail *)
VfsIsRunning: boolean = false;
(* Directory listing ordering, chosen on first VFS run. Updated on any first run after reset *)
VfsDirListingOrder: TDirListingSortType;
(* If true, VFS file/directory hierarchy is built and no mapping is allowed untill full reset *)
VfsTreeIsBuilt: boolean = false;
@ -144,6 +172,7 @@ var
threadvar
DisableVfsForThisThread: boolean;
function TVfsItem.IsDir: boolean;
begin
result := (Self.Info.Base.FileAttributes and Windows.FILE_ATTRIBUTE_DIRECTORY) <> 0;
@ -171,6 +200,12 @@ begin
DisableVfsForThisThread := true;
end;
procedure TThreadVfsDisabler.EnableVfsForThread;
begin
Self.PrevDisableVfsForThisThread := DisableVfsForThisThread;
DisableVfsForThisThread := false;
end;
procedure TThreadVfsDisabler.RestoreVfsForThread;
begin
DisableVfsForThisThread := Self.PrevDisableVfsForThisThread;
@ -297,6 +332,15 @@ begin
end;
end; // .procedure BuildVfsItemsTree
class function TMapping.Make (const AbsVirtPath, AbsRealPath: WideString; OverwriteExisting: boolean; Flags: integer): {O} TMapping;
begin
result := TMapping.Create;
result.AbsVirtPath := AbsVirtPath;
result.AbsRealPath := AbsRealPath;
result.OverwriteExisting := OverwriteExisting;
result.Flags := Flags;
end;
function RunVfs (DirListingOrder: TDirListingSortType): boolean;
begin
result := not DisableVfsForThisThread;
@ -307,6 +351,7 @@ begin
if not VfsIsRunning then begin
if not VfsTreeIsBuilt then begin
VfsDirListingOrder := DirListingOrder;
BuildVfsItemsTree();
SortVfsDirListings(DirListingOrder);
VfsTreeIsBuilt := true;
@ -340,7 +385,9 @@ begin
if result then begin
with VfsCritSection do begin
Enter;
VfsItems.Clear();
VfsItems.Clear;
MappedFiles.Clear;
Mappings.Clear;
VfsIsRunning := false;
VfsTreeIsBuilt := false;
Leave;
@ -472,6 +519,7 @@ begin
VfsItem.RealPath := AbsRealPath;
VfsItem.Priority := Priority;
VfsItem.Attrs := 0;
MappedFiles[WideStrToCaselessKey(AbsRealPath)] := VfsItem;
end; // .if
end; // .if
@ -480,7 +528,7 @@ begin
end;
end; // .function RedirectFile
function _MapDir (const AbsVirtPath, AbsRealPath: WideString; {n} FileInfoPtr: WinNative.PFILE_ID_BOTH_DIR_INFORMATION; OverwriteExisting: boolean; Priority: integer): {Un} TVfsItem;
function _MapDir (const AbsVirtPath, AbsRealPath: WideString; {n} FileInfoPtr: WinNative.PFILE_ID_BOTH_DIR_INFORMATION; OverwriteExisting: boolean; Flags, Priority: integer): {Un} TVfsItem;
var
{O} Subdirs: {O} TList {OF TFileInfo};
{U} SubdirInfo: TFileInfo;
@ -532,7 +580,7 @@ begin
for i := 0 to Subdirs.Count - 1 do begin
SubdirInfo := TFileInfo(Subdirs[i]);
_MapDir(VirtPathPrefix + SubdirInfo.Data.FileName, RealPathPrefix + SubdirInfo.Data.FileName, @SubdirInfo.Data, OverwriteExisting, Priority);
_MapDir(VirtPathPrefix + SubdirInfo.Data.FileName, RealPathPrefix + SubdirInfo.Data.FileName, @SubdirInfo.Data, OverwriteExisting, Flags, Priority);
end;
end; // .if
@ -544,14 +592,26 @@ begin
end; // .function _MapDir
function MapDir (const VirtPath, RealPath: WideString; OverwriteExisting: boolean; Flags: integer = 0): boolean;
var
AbsVirtPath: WideString;
AbsRealPath: WideString;
begin
result := EnterVfsConfig;
if result then begin
result := _MapDir(NormalizePath(VirtPath), NormalizePath(RealPath), nil, OverwriteExisting, AUTO_PRIORITY) <> nil;
AbsVirtPath := VfsUtils.NormalizePath(VirtPath);
AbsRealPath := VfsUtils.NormalizePath(RealPath);
result := (AbsVirtPath <> '') and (AbsRealPath <> '');
if result then begin
Mappings.Add(TMapping.Make(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags));
result := _MapDir(AbsVirtPath, AbsRealPath, nil, OverwriteExisting, Flags, AUTO_PRIORITY) <> nil;
end;
LeaveVfsConfig;
end;
end;
end; // .function MapDir
function CallWithoutVfs (Func: TSingleArgExternalFunc; Arg: pointer = nil): integer; stdcall;
begin
@ -565,7 +625,84 @@ begin
end;
end; // .function CallWithoutVfs
function RefreshVfs: LONGBOOL; stdcall;
var
VfsWasRunning: boolean;
i: integer;
begin
result := not DisableVfsForThisThread;
if result then begin
with VfsCritSection do begin
Enter;
result := VfsTreeIsBuilt;
if result then begin
VfsItems.Clear;
MappedFiles.Clear;
VfsWasRunning := VfsIsRunning;
VfsIsRunning := false;
VfsTreeIsBuilt := false;
for i := 0 to Mappings.Count - 1 do begin
with TMapping(Mappings[i]) do begin
MapDir(AbsVirtPath, AbsRealPath, OverwriteExisting, Flags);
end;
end;
if VfsWasRunning then begin
BuildVfsItemsTree();
SortVfsDirListings(VfsDirListingOrder);
VfsTreeIsBuilt := true;
VfsIsRunning := true;
end;
end;
Leave;
end; // .with
end; // .if
end; // .function RefreshVfs
function RefreshMappedFile (const FilePath: WideString): boolean;
var
{U} VfsItem: TVfsItem;
AbsRealPath: WideString;
FileInfo: TNativeFileInfo;
VfsWasRunning: boolean;
begin
VfsItem := nil;
// * * * * * //
result := not DisableVfsForThisThread;
if result then begin
with VfsCritSection do begin
Enter;
result := VfsTreeIsBuilt;
if result then begin
VfsWasRunning := VfsIsRunning;
VfsIsRunning := false;
AbsRealPath := NormalizePath(FilePath);
VfsItem := TVfsItem(MappedFiles[WideStrToCaselessKey(AbsRealPath)]);
result := (VfsItem <> nil) and GetFileInfo(AbsRealPath, FileInfo);
if result then begin
CopyFileInfoWithoutNames(FileInfo.Base, VfsItem.Info.Base);
end;
VfsIsRunning := VfsWasRunning;
end;
Leave;
end; // .with
end; // .if
end; // .function RefreshMappedFile
begin
VfsCritSection.Init;
VfsItems := DataLib.NewDict(Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);
MappedFiles := DataLib.NewDict(not Utils.OWNS_ITEMS, DataLib.CASE_SENSITIVE);
Mappings := DataLib.NewList(Utils.OWNS_ITEMS);
end.

27
VfsControl.pas
View File

@ -8,9 +8,8 @@ unit VfsControl;
uses
Windows, SysUtils,
Utils, WinUtils, TypeWrappers, DataLib,
Files, StrLib,
VfsBase, VfsUtils, VfsHooks, DlgMes {FIXME DELETEME};
Utils, WinUtils, TypeWrappers, DataLib, Files, StrLib,
VfsBase, VfsUtils, VfsHooks, VfsWatching, DlgMes, FilesEx {FIXME DELETEME};
type
(* Import *)
@ -23,10 +22,11 @@ function RunVfs (DirListingOrder: VfsBase.TDirListingSortType): LONGBOOL; stdcal
(* 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.
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: WideString; Flags: integer = 0): boolean;
(***) implementation (***)
@ -83,7 +83,6 @@ const
UTF8_BOM = #$EF#$BB#$BF;
var
{O} OpenedFile: Files.TFile;
AbsFilePath: WideString;
FileHandle: integer;
FileContents: string;
@ -93,8 +92,6 @@ var
i: integer;
begin
OpenedFile := Files.TFile.Create;
// * * * * * //
AbsFilePath := VfsUtils.NormalizePath(ModListFilePath);
FileHandle := integer(Windows.INVALID_HANDLE_VALUE);
result := AbsFilePath <> '';
@ -129,8 +126,6 @@ begin
Windows.CloseHandle(FileHandle);
end; // .if
// * * * * * //
SysUtils.FreeAndNil(OpenedFile);
end; // .function LoadModList
function MapModsFromList_ (const RootDir, ModsDir: WideString; ModList: TModList; Flags: integer = 0): boolean;
@ -181,4 +176,18 @@ begin
SysUtils.FreeAndNil(ModList);
end; // .function MapModsFromList
var s: string;
begin
// MapModsFromList('D:\Heroes 3', 'D:\heroes 3\Mods', 'd:\heroes 3\mods\list.txt');
// RunVfs(SORT_FIFO);
// ReadFileContents('D:\heroes 3\data\s\__T.erm', s);
// s := copy(s, 1, 100);
// VarDump([s]);
// VfsBase.PauseVfs;
// VfsBase.RefreshVfs;
// VfsBase.RunVfs(SORT_FIFO);
// ReadFileContents('D:\heroes 3\data\s\__T.erm', s);
// s := copy(s, 1, 100);
// VarDump([s]);
// exit;
end.

1
VfsExport.pas
View File

@ -16,6 +16,7 @@ exports
VfsControl.RunVfs,
VfsBase.PauseVfs,
VfsBase.ResetVfs,
VfsBase.RefreshVfs,
VfsBase.CallWithoutVfs;

33
VfsTest.dproj
View File

@ -17,7 +17,6 @@
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_Define>DEBUG</DCC_Define>
<DCC_IOChecking>False</DCC_IOChecking>
<DCC_UnitSearchPath>..\Lib\B2;.\Tests</DCC_UnitSearchPath>
<DCC_ResourcePath>..\Lib\B2;.\Tests</DCC_ResourcePath>
@ -42,38 +41,6 @@
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject>

373
VfsWatching.pas Normal file
View File

@ -0,0 +1,373 @@
unit VfsWatching;
(*
Description: provides means to watch for mapped directories changes and refresh VFS.
Works unreliably when trying to watch the whole logical drive.
*)
(***) interface (***)
uses
Windows, SysUtils, Math,
Utils, Concur, WinUtils, StrLib, WinNative,
VfsBase, VfsUtils, DlgMes, Files {FIXME DELETEME};
(***) implementation (***)
type
(* Import *)
THandle = Windows.THandle;
const
(* Import *)
INVALID_HANDLE_VALUE = Windows.INVALID_HANDLE_VALUE;
STOP_EVENT_HANDLE_IND = 0;
NOTIFICATION_HANDLE_INDEX = 1;
NUM_WATCHED_HANDLES = 2;
type
TDirChangeAction = (NOTIFY_FILE_ADDED, NOTIFY_FILE_REMOVED, NOTIFY_FILE_MODIFIED, NOTIFY_FILE_RENAMED_FROM_NAME, NOTIFY_FILE_RENAMED_TO_NAME,
NOTIFY_STOP_EVENT, NOTIFY_TIMEOUT, NOTIFY_TOO_MANY_CHANGES, NOTIFY_UNKNOWN_ACTION);
TDirChangeFilter = set of TDirChangeAction;
const
NOTIFY_ALL = [NOTIFY_FILE_ADDED, NOTIFY_FILE_REMOVED, NOTIFY_FILE_MODIFIED, NOTIFY_FILE_RENAMED_FROM_NAME, NOTIFY_FILE_RENAMED_TO_NAME];
NO_STOP_EVENT = 0;
INFINITE = Windows.INFINITE;
type
(* Directory change record *)
TDirChange = record
Action: TDirChangeAction;
(* Absolute expanded and normalized path to file, that triggered notification *)
FilePath: WideString;
end;
IDirChangesIterator = interface
function IterNext ({out} var DirChange: TDirChange; StopEvent: THandle = 0; Timeout: integer = integer(Windows.INFINITE); NotifyFilter: TDirChangeFilter = NOTIFY_ALL): boolean;
end;
TDirChangesIterator = class (Utils.TManagedObject, IDirChangesIterator)
protected const
BUF_SIZE = 65500;
protected
{O} fDirHandle: THandle;
{O} fNotifyEvent: THandle;
fDirPath: WideString;
fBuf: array [0..BUF_SIZE - 1] of byte;
fBufSize: integer;
fBufPos: integer;
fIsEnd: boolean;
public
constructor Create (const DirPath: WideString); overload;
destructor Destroy; override;
function IterNext ({out} var DirChange: TDirChange; StopEvent: THandle = 0; Timeout: integer = integer(Windows.INFINITE); NotifyFilter: TDirChangeFilter = NOTIFY_ALL): boolean;
end; // .class TDirChangesIterator
var
WatcherCritSection: Concur.TCritSection;
AbsWatcherDir: WideString;
WatcherDebounceInterval: integer;
WatcherStopEvent: THandle;
WatcherIsRunning: boolean;
WatcherThreadHandle: THandle;
WatcherThreadId: cardinal;
function IsValidHandle (Handle: THandle): boolean; inline;
begin
result := (Handle <> 0) and (Handle <> INVALID_HANDLE_VALUE);
end;
constructor TDirChangesIterator.Create (const DirPath: WideString);
const
MANUAL_RESET_EVENT = true;
begin
Self.fDirPath := VfsUtils.NormalizePath(DirPath);
Self.fDirHandle := Windows.CreateFileW(PWideChar(Self.fDirPath), Windows.GENERIC_READ, Windows.FILE_SHARE_READ or Windows.FILE_SHARE_WRITE, nil,
Windows.OPEN_EXISTING, Windows.FILE_FLAG_BACKUP_SEMANTICS or Windows.FILE_FLAG_OVERLAPPED, 0);
if IsValidHandle(Self.fDirHandle) then begin
Self.fNotifyEvent := Windows.CreateEventW(nil, MANUAL_RESET_EVENT, false, nil);
if not IsValidHandle(Self.fNotifyEvent) then begin
Windows.CloseHandle(Self.fDirHandle);
Self.fDirHandle := 0;
end;
end;
Self.fIsEnd := not IsValidHandle(Self.fDirHandle);
end; // .constructor TDirChangesIterator.Create
destructor TDirChangesIterator.Destroy;
begin
if IsValidHandle(Self.fDirHandle) then begin
Windows.CloseHandle(Self.fDirHandle);
end;
if IsValidHandle(Self.fNotifyEvent) then begin
Windows.CloseHandle(Self.fNotifyEvent);
end;
end;
function DecodeNativeDirChangeAction (Action: integer): TDirChangeAction;
begin
case Action of
Windows.FILE_ACTION_ADDED: result := NOTIFY_FILE_ADDED;
Windows.FILE_ACTION_REMOVED: result := NOTIFY_FILE_REMOVED;
Windows.FILE_ACTION_MODIFIED: result := NOTIFY_FILE_MODIFIED;
Windows.FILE_ACTION_RENAMED_OLD_NAME: result := NOTIFY_FILE_RENAMED_FROM_NAME;
Windows.FILE_ACTION_RENAMED_NEW_NAME: result := NOTIFY_FILE_RENAMED_TO_NAME;
else
result := NOTIFY_UNKNOWN_ACTION;
end;
end;
function DirChangeFilterToNative (Filter: TDirChangeFilter): integer;
begin
result := 0;
if NOTIFY_FILE_ADDED in Filter then result := result or Windows.FILE_ACTION_ADDED;
if NOTIFY_FILE_REMOVED in Filter then result := result or Windows.FILE_ACTION_REMOVED;
if NOTIFY_FILE_MODIFIED in Filter then result := result or Windows.FILE_ACTION_MODIFIED;
if NOTIFY_FILE_RENAMED_FROM_NAME in Filter then result := result or Windows.FILE_ACTION_RENAMED_OLD_NAME;
if NOTIFY_FILE_RENAMED_TO_NAME in Filter then result := result or Windows.FILE_ACTION_RENAMED_NEW_NAME;
end;
function TDirChangesIterator.IterNext ({out} var DirChange: TDirChange; StopEvent: THandle = 0; Timeout: integer = integer(Windows.INFINITE); NotifyFilter: TDirChangeFilter = NOTIFY_ALL): boolean;
const
WATCH_SUBTREE = true;
WAIT_OVERLAPPED = true;
var
{n} NotifInfoInBuf: WinNative.PFILE_NOTIFY_INFORMATION;
AsyncRes: Windows.TOverlapped;
TriggeredEvent: THandle;
Dummy: integer;
begin
NotifInfoInBuf := nil;
// * * * * * //
result := not Self.fIsEnd;
if not result then begin
exit;
end;
if Timeout = 0 then begin
DirChange.Action := NOTIFY_TIMEOUT;
exit;
end;
if Self.fBufPos < fBufSize then begin
NotifInfoInBuf := @Self.fBuf[Self.fBufPos];
DirChange.Action := DecodeNativeDirChangeAction(NotifInfoInBuf.Action);
if DirChange.Action = NOTIFY_FILE_REMOVED then begin
DirChange.FilePath := VfsUtils.AddBackslash(Self.fDirPath) + NotifInfoInBuf.GetFileName;
DirChange.FilePath := VfsUtils.AddBackslash(WinUtils.GetLongPathW(StrLib.ExtractDirPathW(DirChange.FilePath))) + StrLib.ExtractFileNameW(DirChange.FilePath);
end else begin
DirChange.FilePath := WinUtils.GetLongPathW(VfsUtils.AddBackslash(Self.fDirPath) + NotifInfoInBuf.GetFileName);
end;
Self.fBufPos := Utils.IfThen(NotifInfoInBuf.NextEntryOffset <> 0, Self.fBufPos + integer(NotifInfoInBuf.NextEntryOffset), Self.BUF_SIZE);
end else begin
FillChar(AsyncRes, sizeof(AsyncRes), 0);
AsyncRes.hEvent := Self.fNotifyEvent;
Windows.ResetEvent(Self.fNotifyEvent);
Self.fBufSize := 0;
Self.fBufPos := 0;
result := Windows.ReadDirectoryChangesW(Self.fDirHandle, @Self.fBuf, sizeof(Self.fBuf), WATCH_SUBTREE, DirChangeFilterToNative(NotifyFilter), @Dummy, @AsyncRes, nil);
if result then begin
DirChange.FilePath := '';
case WinUtils.WaitForObjects([StopEvent, Self.fNotifyEvent], TriggeredEvent, Timeout) of
WinUtils.WR_WAITED: begin
if TriggeredEvent = StopEvent then begin
DirChange.Action := NOTIFY_STOP_EVENT;
end else begin
result := Windows.GetOverlappedResult(Self.fNotifyEvent, AsyncRes, cardinal(Self.fBufSize), not WAIT_OVERLAPPED);
if result then begin
if Self.fBufSize = 0 then begin
DirChange.Action := NOTIFY_TOO_MANY_CHANGES;
end else if Self.fBufSize < sizeof(NotifInfoInBuf^) + sizeof(WideChar) then begin
result := false;
end else begin
result := Self.IterNext(DirChange, StopEvent, Timeout, NotifyFilter);
end;
end;
end;
end; // .case WR_WAITED
WinUtils.WR_TIMEOUT: begin
DirChange.Action := NOTIFY_TIMEOUT;
end;
else
result := false;
end; // .switch wait result
end; // .if
Self.fIsEnd := not result;
end; // .else
end; // .function TDirChangesIterator.IterNext
function ReadDirChanges (const DirPath: WideString): IDirChangesIterator;
begin
result := TDirChangesIterator.Create(DirPath);
end;
// function ReadNotification (const DirPath: WideString; var NotificationHandle: THandle): boolean;
// begin
// if IsValidHandle(NotificationHandle) then begin
// result := FindNextChangeNotification(NotificationHandle);
// if not result then begin
// Windows.FindCloseChangeNotification(NotificationHandle);
// NotificationHandle := INVALID_HANDLE_VALUE;
// end;
// end else begin
// NotificationHandle := FindFirstChangeNotificationW(PWideChar(DirPath), true, FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or FILE_NOTIFY_CHANGE_ATTRIBUTES or
// FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE);
// result := IsValidHandle(NotificationHandle);
// end;
// end; // .function ReadNotification
function WatcherThreadProc (Arg: integer): integer; stdcall;
var
IsEnd: LONGBOOL;
NeedFullRescan: LONGBOOL;
CurrentTime: Int64;
LastChangeTime: Int64;
PlannedRescanTime: Int64;
Timeout: integer;
DummyEvent: THandle;
DirChangesScanner: IDirChangesIterator;
DirChange: TDirChange;
filesize: integer;
begin
DirChangesScanner := nil;
// * * * * * //
IsEnd := false;
NeedFullRescan := false;
LastChangeTime := 0;
result := 0;
with VfsBase.GetThreadVfsDisabler do begin
DisableVfsForThread;
try
while not IsEnd do begin
CurrentTime := GetMicroTime;
PlannedRescanTime := LastChangeTime + Int64(WatcherDebounceInterval);
if NeedFullRescan and (PlannedRescanTime <= CurrentTime) then begin
VfsBase.RefreshVfs;
NeedFullRescan := false;
VarDump(['Rescaned']);
end;
if DirChangesScanner = nil then begin
DirChangesScanner := TDirChangesIterator.Create(AbsWatcherDir);
end;
// Failed to start watching directory
if not DirChangesScanner.IterNext(DirChange, WatcherStopEvent, Utils.IfThen(boolean(NeedFullRescan), integer(PlannedRescanTime - CurrentTime), integer(Windows.INFINITE))) then begin
VarDump([':(', AbsWatcherDir]);
// Force scanner recreation later
DirChangesScanner := nil;
// Wait and retry, unless stop signal is received
Timeout := Utils.IfThen(NeedFullRescan, Min(WatcherDebounceInterval, integer(PlannedRescanTime - CurrentTime)), WatcherDebounceInterval);
if WinUtils.WaitForObjects([WatcherStopEvent], DummyEvent, Timeout) = WinUtils.WR_WAITED then begin
IsEnd := true;
end;
// Ok, got some signal
end else begin
VarDump([ord(DirChange.Action), DirChange.FilePath]);
if DirChange.Action = NOTIFY_STOP_EVENT then begin
IsEnd := true;
end else if DirChange.Action = NOTIFY_TIMEOUT then begin
// Will perform full rescan on next loop iteration
end else if DirChange.Action in [NOTIFY_FILE_ADDED, NOTIFY_FILE_REMOVED, NOTIFY_FILE_RENAMED_FROM_NAME, NOTIFY_FILE_RENAMED_TO_NAME, NOTIFY_UNKNOWN_ACTION, NOTIFY_TOO_MANY_CHANGES] then begin
LastChangeTime := WinUtils.GetMicroTime;
NeedFullRescan := true;
end else if DirChange.Action = NOTIFY_FILE_MODIFIED then begin
if not NeedFullRescan then begin
VfsBase.RefreshMappedFile(DirChange.FilePath);
with VfsBase.GetThreadVfsDisabler do begin
EnableVfsForThread;
Files.GetFileSize(DirChange.FilePath, FileSize);
RestoreVfsForThread;
end;
VarDump([DirChange.FilePath, 'New size is', FileSize], 'Updated');
end;
LastChangeTime := WinUtils.GetMicroTime;
end;
end; // .else
end; // .while
finally
RestoreVfsForThread;
end; // .try
end; // .with
end; // .function WatcherThreadProc
function RunWatcher (const WatchDir: WideString; DebounceInterval: integer): boolean;
const
MANUAL_RESET = true;
begin
with WatcherCritSection do begin
Enter;
result := not WatcherIsRunning;
if result then begin
AbsWatcherDir := VfsUtils.NormalizePath(WatchDir);
WatcherDebounceInterval := Max(0, DebounceInterval);
if not WinUtils.IsValidHandle(WatcherStopEvent) then begin
WatcherStopEvent := Windows.CreateEventW(nil, MANUAL_RESET, false, nil);
result := WinUtils.IsValidHandle(WatcherStopEvent);
end;
if result then begin
WatcherThreadHandle := Windows.CreateThread(nil, 0, @WatcherThreadProc, nil, 0, WatcherThreadId);
end;
end;
Leave;
end;
end; // .function RunWatcher
var
DirChange: TDirChange;
begin
WatcherCritSection.Init;
RunWatcher(GetCurrentDir + '\Tests\', 250);
// with ReadDirChanges('D:') do begin
// while IterNext(DirChange, 0) do begin
// VarDump([ord(DirChange.Action), DirChange.FilePath]);
// end;
// end;
// exit;
end.