diff --git a/Tests/VfsIntegratedTest.pas b/Tests/VfsIntegratedTest.pas index 170f965..53d5a82 100644 --- a/Tests/VfsIntegratedTest.pas +++ b/Tests/VfsIntegratedTest.pas @@ -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; diff --git a/VfsBase.pas b/VfsBase.pas index 95f25f4..af38ec8 100644 --- a/VfsBase.pas +++ b/VfsBase.pas @@ -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); + 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. \ No newline at end of file diff --git a/VfsControl.pas b/VfsControl.pas index c6ef99d..47cf003 100644 --- a/VfsControl.pas +++ b/VfsControl.pas @@ -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,18 +83,15 @@ const UTF8_BOM = #$EF#$BB#$BF; var -{O} OpenedFile: Files.TFile; - AbsFilePath: WideString; - FileHandle: integer; - FileContents: string; - Lines: Utils.TArrayOfStr; - ModNameUtf8: string; - ModName: WideString; - i: integer; + AbsFilePath: WideString; + FileHandle: integer; + FileContents: string; + Lines: Utils.TArrayOfStr; + ModNameUtf8: string; + ModName: WideString; + 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. \ No newline at end of file diff --git a/VfsExport.pas b/VfsExport.pas index 79e1586..0342240 100644 --- a/VfsExport.pas +++ b/VfsExport.pas @@ -16,6 +16,7 @@ exports VfsControl.RunVfs, VfsBase.PauseVfs, VfsBase.ResetVfs, + VfsBase.RefreshVfs, VfsBase.CallWithoutVfs; diff --git a/VfsTest.dproj b/VfsTest.dproj index 33381f2..7034bc9 100644 --- a/VfsTest.dproj +++ b/VfsTest.dproj @@ -17,7 +17,6 @@ 7.0 - DEBUG False ..\Lib\B2;.\Tests ..\Lib\B2;.\Tests @@ -42,38 +41,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Microsoft Office 2000 Sample Automation Server Wrapper Components Microsoft Office XP Sample Automation Server Wrapper Components diff --git a/VfsWatching.pas b/VfsWatching.pas new file mode 100644 index 0000000..3f076de --- /dev/null +++ b/VfsWatching.pas @@ -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. \ No newline at end of file