Directory-Monitor... experimentell... klappt nicht so recht mit UNC-Pfaden :(
This commit is contained in:
Michael Schimmel
+316
-224
@@ -1,4 +1,4 @@
|
||||
unit Myc.DirectoryMonitor;
|
||||
unit Myc.DirectoryMonitor experimental;
|
||||
|
||||
interface
|
||||
|
||||
@@ -29,7 +29,6 @@ type
|
||||
|
||||
// Represents a single file and its properties.
|
||||
IFileInfo = interface
|
||||
['{D6B3E3B3-5A27-4E2F-8E3B-1B4F29D8E7C5}'] // Never remove this line! It is just for the LSP.
|
||||
{$region 'private'}
|
||||
function GetFullPath: string;
|
||||
function GetFileName: string;
|
||||
@@ -64,13 +63,14 @@ type
|
||||
|
||||
// Monitors directories for file changes.
|
||||
IDirectoryMonitor = interface
|
||||
['{A1B2C3D4-E5F6-A7B8-C9D0-E1F2A3B4C5D6}'] // Never remove this line! It is just for the LSP.
|
||||
{$region 'private'}
|
||||
function GetFiles: TArray<IFileInfo>;
|
||||
function GetFiles(const Name: String): IFileInfo;
|
||||
function GetFileCount: Integer;
|
||||
{$endregion}
|
||||
|
||||
// Retrieves a snapshot of the currently known files.
|
||||
property Files: TArray<IFileInfo> read GetFiles;
|
||||
property Files[const Name: String]: IFileInfo read GetFiles;
|
||||
property FileCount: Integer read GetFileCount;
|
||||
|
||||
// Checks the current state of a tracked file against the file system.
|
||||
function CheckState(const FileInfo: IFileInfo): TFileState;
|
||||
@@ -81,7 +81,6 @@ type
|
||||
|
||||
// Factory for creating directory monitors.
|
||||
IDirectoryMonitorFactory = interface
|
||||
['{F9E8D7C6-B5A4-4321-9876-FEDCBA987654}'] // Never remove this line! It is just for the LSP.
|
||||
// Adds a directory to the watch list.
|
||||
procedure AddDirectory(const DirPath: string; SubDirHandling: TSubDirectoryHandling);
|
||||
// Adds a file extension to filter by (e.g., '.txt'). Use '*' for all files.
|
||||
@@ -93,7 +92,7 @@ type
|
||||
function CreateMonitor: IDirectoryMonitor;
|
||||
end;
|
||||
|
||||
function DirectoryMonitorFactory: IDirectoryMonitorFactory;
|
||||
function CreateDirectoryMonitorFactory: IDirectoryMonitorFactory;
|
||||
|
||||
implementation
|
||||
|
||||
@@ -105,7 +104,35 @@ uses
|
||||
System.SyncObjs,
|
||||
System.StrUtils;
|
||||
|
||||
const
|
||||
// Buffer size for ReadDirectoryChangesW notifications
|
||||
NOTIFY_BUFFER_SIZE = 65536; // 64 KB
|
||||
|
||||
type
|
||||
// Manual definition of FILE_NOTIFY_INFORMATION as it seems to be missing
|
||||
// from the project's Winapi.Windows unit.
|
||||
PFileNotifyInformation = ^TFileNotifyInformation;
|
||||
TFileNotifyInformation = packed record
|
||||
NextEntryOffset: DWORD;
|
||||
Action: DWORD;
|
||||
FileNameLength: DWORD;
|
||||
FileName: array[0..0] of WideChar;
|
||||
end;
|
||||
|
||||
TDirectoryWatch = record
|
||||
Directory: string;
|
||||
WatchSubtree: Boolean;
|
||||
end;
|
||||
|
||||
// Private record to hold all necessary information for monitoring a single directory.
|
||||
TWatchInfo = record
|
||||
Directory: string;
|
||||
Handle: THandle;
|
||||
Subtree: Boolean;
|
||||
Overlapped: TOverlapped;
|
||||
Buffer: TArray<Byte>;
|
||||
end;
|
||||
|
||||
// Concrete implementation of IFileInfo
|
||||
TFileInfo = class(TInterfacedObject, IFileInfo)
|
||||
private
|
||||
@@ -115,7 +142,7 @@ type
|
||||
FCreationTime: TDateTime;
|
||||
FLastWriteTime: TDateTime;
|
||||
FSize: Int64;
|
||||
FNotifyList: TMycNotifyList<IInterface>; // Stores TFunc<IFileInfo, TFileState, Boolean> after casting
|
||||
FNotifyList: TMycNotifyList<TFunc<IFileInfo, TFileState, Boolean>>;
|
||||
|
||||
function GetFullPath: string;
|
||||
function GetFileName: string;
|
||||
@@ -124,36 +151,32 @@ type
|
||||
function GetLastWriteTime: TDateTime;
|
||||
function GetSize: Int64;
|
||||
public
|
||||
constructor Create(const SearchRec: TSearchRec);
|
||||
|
||||
constructor Create(const AFullPath: string; const SearchRec: TSearchRec);
|
||||
procedure AddChangeNotification(const ChangeNotification: TFunc<IFileInfo, TFileState, Boolean>);
|
||||
procedure NotifyChanges(NewState: TFileState);
|
||||
end;
|
||||
|
||||
TDirectoryWatch = record
|
||||
Directory: string;
|
||||
WatchSubtree: Boolean;
|
||||
end;
|
||||
|
||||
// Concrete implementation of IDirectoryMonitor
|
||||
TDirectoryMonitor = class(TInterfacedObject, IDirectoryMonitor)
|
||||
private
|
||||
FDirectories: TArray<TDirectoryWatch>;
|
||||
FExtensions: TArray<string>;
|
||||
FChangeKinds: TFileChangeKinds;
|
||||
FWatchInfos: TArray<TWatchInfo>;
|
||||
|
||||
FFiles: TObjectDictionary<string, IFileInfo>;
|
||||
FFiles: TDictionary<string, IFileInfo>;
|
||||
FLock: TCriticalSection;
|
||||
FThreadState: TState;
|
||||
FStopping: Boolean;
|
||||
FStopEvent: THandle;
|
||||
|
||||
procedure RescanDirectory(const Watch: TDirectoryWatch);
|
||||
procedure InitialScan(const WatchInfo: TWatchInfo);
|
||||
procedure MonitorLoop;
|
||||
procedure RescanAll;
|
||||
procedure ProcessChangeBuffer(const WatchInfo: TWatchInfo; BytesWritten: DWORD);
|
||||
procedure HandleFileChange(Action: DWORD; const BasePath, FileName: string);
|
||||
function TranslateChangeKinds: DWORD;
|
||||
class function FileMatchesExtensions(const FileName: string; const Extensions: TArray<string>): Boolean; static;
|
||||
|
||||
function GetFiles: TArray<IFileInfo>;
|
||||
function GetFiles(const Name: String): IFileInfo;
|
||||
function GetFileCount: Integer;
|
||||
public
|
||||
constructor Create(const Directories: TArray<TDirectoryWatch>; const Extensions: TArray<string>; ChangeKinds: TFileChangeKinds);
|
||||
destructor Destroy; override;
|
||||
@@ -178,56 +201,42 @@ type
|
||||
function CreateMonitor: IDirectoryMonitor;
|
||||
end;
|
||||
|
||||
var
|
||||
GFactory: IDirectoryMonitorFactory;
|
||||
GFactoryLock: TCriticalSection;
|
||||
|
||||
function DirectoryMonitorFactory: IDirectoryMonitorFactory;
|
||||
function CreateDirectoryMonitorFactory: IDirectoryMonitorFactory;
|
||||
begin
|
||||
if not Assigned(GFactory) then
|
||||
begin
|
||||
GFactoryLock.Acquire;
|
||||
try
|
||||
if not Assigned(GFactory) then
|
||||
GFactory := TDirectoryMonitorFactory.Create;
|
||||
finally
|
||||
GFactoryLock.Release;
|
||||
end;
|
||||
end;
|
||||
Result := GFactory;
|
||||
Result := TDirectoryMonitorFactory.Create;
|
||||
end;
|
||||
|
||||
{ TFileInfo }
|
||||
|
||||
constructor TFileInfo.Create(const SearchRec: TSearchRec);
|
||||
constructor TFileInfo.Create(const AFullPath: string; const SearchRec: TSearchRec);
|
||||
begin
|
||||
inherited Create;
|
||||
FFullPath := SearchRec.Name;
|
||||
FFileName := TPath.GetFileName(SearchRec.Name);
|
||||
FExtension := TPath.GetExtension(SearchRec.Name);
|
||||
FFullPath := AFullPath;
|
||||
FFileName := TPath.GetFileName(AFullPath);
|
||||
FExtension := TPath.GetExtension(AFullPath);
|
||||
FCreationTime := SearchRec.CreationTime;
|
||||
FLastWriteTime := SearchRec.TimeStamp; // TSearchRec.Time is deprecated!
|
||||
FLastWriteTime := SearchRec.TimeStamp;
|
||||
FSize := SearchRec.Size;
|
||||
end;
|
||||
|
||||
procedure TFileInfo.AddChangeNotification(const ChangeNotification: TFunc<IFileInfo, TFileState, Boolean>);
|
||||
begin
|
||||
// Store the function reference as a plain IInterface. We will cast it back upon notification.
|
||||
FNotifyList.Advise(TFunc<IFileInfo, TFileState, Boolean>(ChangeNotification) as IInterface);
|
||||
FNotifyList.Lock;
|
||||
try
|
||||
FNotifyList.Advise(ChangeNotification);
|
||||
finally
|
||||
FNotifyList.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileInfo.NotifyChanges(NewState: TFileState);
|
||||
begin
|
||||
FNotifyList.Notify(
|
||||
function(const Obj: IInterface): Boolean
|
||||
var
|
||||
func: TFunc<IFileInfo, TFileState, Boolean>;
|
||||
begin
|
||||
// Cast back from IInterface to the actual function type
|
||||
func := TFunc<IFileInfo, TFileState, Boolean>(Obj);
|
||||
Result := func(Self, NewState);
|
||||
end
|
||||
);
|
||||
FNotifyList.Lock;
|
||||
try
|
||||
FNotifyList.Notify(function(const Func: TFunc<IFileInfo, TFileState, Boolean>): Boolean begin Result := Func(Self, NewState); end);
|
||||
finally
|
||||
FNotifyList.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFileInfo.GetCreationTime: TDateTime;
|
||||
@@ -267,39 +276,275 @@ constructor TDirectoryMonitor.Create(
|
||||
const Extensions: TArray<string>;
|
||||
ChangeKinds: TFileChangeKinds
|
||||
);
|
||||
var
|
||||
i: Integer;
|
||||
watch: TDirectoryWatch;
|
||||
begin
|
||||
inherited Create;
|
||||
FDirectories := Directories;
|
||||
FExtensions := Extensions;
|
||||
FChangeKinds := ChangeKinds;
|
||||
FStopping := false;
|
||||
FLock := TCriticalSection.Create;
|
||||
FFiles := TObjectDictionary<string, IFileInfo>.Create([doOwnsValues]);
|
||||
FFiles := TDictionary<string, IFileInfo>.Create;
|
||||
FStopEvent := CreateEvent(nil, TRUE, FALSE, nil);
|
||||
|
||||
// Perform a robust initial scan to populate the file list
|
||||
RescanAll;
|
||||
SetLength(FWatchInfos, Length(Directories));
|
||||
for i := 0 to High(Directories) do
|
||||
begin
|
||||
watch := Directories[i];
|
||||
FWatchInfos[i].Directory := watch.Directory;
|
||||
FWatchInfos[i].Subtree := watch.WatchSubtree;
|
||||
FWatchInfos[i].Handle :=
|
||||
CreateFile(
|
||||
PChar(watch.Directory),
|
||||
FILE_LIST_DIRECTORY,
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
|
||||
nil,
|
||||
OPEN_EXISTING,
|
||||
FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,
|
||||
0
|
||||
);
|
||||
FWatchInfos[i].Overlapped.hEvent := CreateEvent(nil, TRUE, FALSE, nil);
|
||||
SetLength(FWatchInfos[i].Buffer, NOTIFY_BUFFER_SIZE);
|
||||
|
||||
if FWatchInfos[i].Handle <> INVALID_HANDLE_VALUE then
|
||||
InitialScan(FWatchInfos[i]);
|
||||
end;
|
||||
|
||||
// Start the background monitoring thread
|
||||
FThreadState := TaskManager.CreateThread(MonitorLoop);
|
||||
end;
|
||||
|
||||
destructor TDirectoryMonitor.Destroy;
|
||||
var
|
||||
info: TWatchInfo;
|
||||
begin
|
||||
// Signal the monitoring thread to stop
|
||||
FStopping := true;
|
||||
// Signal the monitoring thread to stop.
|
||||
SetEvent(FStopEvent);
|
||||
|
||||
// Wait for the thread to terminate gracefully
|
||||
// Cancel all pending IO operations for the handle to ensure the thread is unblocked.
|
||||
for info in FWatchInfos do
|
||||
begin
|
||||
if info.Handle <> INVALID_HANDLE_VALUE then
|
||||
CancelIoEx(info.Handle, nil);
|
||||
end;
|
||||
|
||||
// Wait for the thread to terminate gracefully.
|
||||
TaskManager.WaitFor(FThreadState);
|
||||
|
||||
// After the thread has terminated, clean up all handles and resources.
|
||||
for info in FWatchInfos do
|
||||
begin
|
||||
if info.Handle <> INVALID_HANDLE_VALUE then
|
||||
CloseHandle(info.Handle);
|
||||
if info.Overlapped.hEvent <> 0 then
|
||||
CloseHandle(info.Overlapped.hEvent);
|
||||
end;
|
||||
|
||||
CloseHandle(FStopEvent);
|
||||
FFiles.Free;
|
||||
FLock.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.InitialScan(const WatchInfo: TWatchInfo);
|
||||
|
||||
procedure Scan(const Dir: string);
|
||||
var
|
||||
filePath, subDirPath: string;
|
||||
sr: TSearchRec;
|
||||
begin
|
||||
try
|
||||
// 1. Process all files in the current directory using the modern, more robust API.
|
||||
for filePath in TDirectory.GetFiles(Dir) do
|
||||
begin
|
||||
if FileMatchesExtensions(filePath, FExtensions) then
|
||||
begin
|
||||
// We still need FindFirst here, but only on a specific file,
|
||||
// not for enumeration, which avoids the bug.
|
||||
if System.SysUtils.FindFirst(filePath, faAnyFile, sr) = 0 then
|
||||
try
|
||||
FFiles.AddOrSetValue(filePath, TFileInfo.Create(filePath, sr));
|
||||
finally
|
||||
System.SysUtils.FindClose(sr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// 2. If recursive, process all subdirectories.
|
||||
if WatchInfo.Subtree then
|
||||
begin
|
||||
for subDirPath in TDirectory.GetDirectories(Dir) do
|
||||
begin
|
||||
Scan(subDirPath); // Recurse into subdirectory
|
||||
end;
|
||||
end;
|
||||
except
|
||||
// Ignore exceptions from inaccessible directories (e.g., access denied)
|
||||
on E: EInOutError do
|
||||
begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FreeAndNil(FFiles);
|
||||
Scan(WatchInfo.Directory);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
FreeAndNil(FLock);
|
||||
inherited;
|
||||
procedure TDirectoryMonitor.MonitorLoop;
|
||||
var
|
||||
handles: TArray<THandle>;
|
||||
i: Integer;
|
||||
notifyFilter: DWORD;
|
||||
waitResult: DWORD;
|
||||
bytesRead: DWORD;
|
||||
changedIndex: Integer;
|
||||
success: Boolean;
|
||||
begin
|
||||
notifyFilter := TranslateChangeKinds();
|
||||
|
||||
for i := 0 to High(FWatchInfos) do
|
||||
begin
|
||||
if FWatchInfos[i].Handle <> INVALID_HANDLE_VALUE then
|
||||
begin
|
||||
ReadDirectoryChangesW(
|
||||
FWatchInfos[i].Handle,
|
||||
@FWatchInfos[i].Buffer[0],
|
||||
Length(FWatchInfos[i].Buffer),
|
||||
FWatchInfos[i].Subtree,
|
||||
notifyFilter,
|
||||
nil,
|
||||
@FWatchInfos[i].Overlapped,
|
||||
nil
|
||||
);
|
||||
end;
|
||||
end;
|
||||
|
||||
SetLength(handles, Length(FWatchInfos) + 1);
|
||||
handles[0] := FStopEvent;
|
||||
for i := 0 to High(FWatchInfos) do
|
||||
handles[i + 1] := FWatchInfos[i].Overlapped.hEvent;
|
||||
|
||||
while True do
|
||||
begin
|
||||
waitResult := WaitForMultipleObjects(Length(handles), @handles[0], FALSE, INFINITE);
|
||||
|
||||
if waitResult = WAIT_OBJECT_0 then
|
||||
break;
|
||||
|
||||
if (waitResult >= WAIT_OBJECT_0 + 1) and (waitResult < WAIT_OBJECT_0 + Length(handles)) then
|
||||
begin
|
||||
changedIndex := waitResult - (WAIT_OBJECT_0 + 1);
|
||||
|
||||
success := GetOverlappedResult(FWatchInfos[changedIndex].Handle, FWatchInfos[changedIndex].Overlapped, bytesRead, FALSE);
|
||||
|
||||
if success then
|
||||
begin
|
||||
if bytesRead > 0 then
|
||||
begin
|
||||
ProcessChangeBuffer(FWatchInfos[changedIndex], bytesRead)
|
||||
end
|
||||
else
|
||||
begin
|
||||
InitialScan(FWatchInfos[changedIndex]);
|
||||
end;
|
||||
end;
|
||||
|
||||
ReadDirectoryChangesW(
|
||||
FWatchInfos[changedIndex].Handle,
|
||||
@FWatchInfos[changedIndex].Buffer[0],
|
||||
Length(FWatchInfos[changedIndex].Buffer),
|
||||
FWatchInfos[changedIndex].Subtree,
|
||||
notifyFilter,
|
||||
nil,
|
||||
@FWatchInfos[changedIndex].Overlapped,
|
||||
nil
|
||||
);
|
||||
end
|
||||
else
|
||||
begin
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
// No cleanup logic here; the destructor is responsible.
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.ProcessChangeBuffer(const WatchInfo: TWatchInfo; BytesWritten: DWORD);
|
||||
var
|
||||
pInfo: PFileNotifyInformation;
|
||||
offset: DWORD;
|
||||
fileName: string;
|
||||
begin
|
||||
pInfo := PFileNotifyInformation(@WatchInfo.Buffer[0]);
|
||||
while True do
|
||||
begin
|
||||
SetString(fileName, PWideChar(@pInfo.FileName), pInfo.FileNameLength div SizeOf(WideChar));
|
||||
|
||||
HandleFileChange(pInfo.Action, WatchInfo.Directory, fileName);
|
||||
|
||||
if pInfo.NextEntryOffset = 0 then
|
||||
break;
|
||||
|
||||
offset := pInfo.NextEntryOffset;
|
||||
pInfo := PFileNotifyInformation(PByte(pInfo) + offset);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.HandleFileChange(Action: DWORD; const BasePath, FileName: string);
|
||||
var
|
||||
fullPath: string;
|
||||
sr: TSearchRec;
|
||||
oldFileInfo, newFileInfo: IFileInfo;
|
||||
begin
|
||||
fullPath := TPath.Combine(BasePath, FileName);
|
||||
|
||||
if not FileMatchesExtensions(fullPath, FExtensions) then
|
||||
exit;
|
||||
|
||||
case Action of
|
||||
FILE_ACTION_ADDED, FILE_ACTION_MODIFIED, FILE_ACTION_RENAMED_NEW_NAME:
|
||||
begin
|
||||
if TFile.Exists(fullPath) and (System.SysUtils.FindFirst(fullPath, faAnyFile, sr) = 0) then
|
||||
try
|
||||
FLock.Enter;
|
||||
try
|
||||
newFileInfo := TFileInfo.Create(fullPath, sr);
|
||||
|
||||
if FFiles.TryGetValue(fullPath, oldFileInfo) then
|
||||
begin
|
||||
(oldFileInfo as TFileInfo).NotifyChanges(TFileState.Changed);
|
||||
end
|
||||
else
|
||||
begin
|
||||
(newFileInfo as TFileInfo).NotifyChanges(TFileState.Added);
|
||||
end;
|
||||
|
||||
FFiles.AddOrSetValue(fullPath, newFileInfo);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
finally
|
||||
System.SysUtils.FindClose(sr);
|
||||
end;
|
||||
end;
|
||||
|
||||
FILE_ACTION_REMOVED, FILE_ACTION_RENAMED_OLD_NAME:
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
if FFiles.TryGetValue(fullPath, oldFileInfo) then
|
||||
begin
|
||||
(oldFileInfo as TFileInfo).NotifyChanges(TFileState.Deleted);
|
||||
FFiles.Remove(fullPath);
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDirectoryMonitor.TranslateChangeKinds: DWORD;
|
||||
@@ -336,164 +581,22 @@ begin
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.RescanDirectory(const Watch: TDirectoryWatch);
|
||||
var
|
||||
foundFiles: THashSet<String>;
|
||||
path: string;
|
||||
sr: TSearchRec;
|
||||
keysToRemove: TList<string>;
|
||||
rootPathWithDelim: string;
|
||||
|
||||
procedure Scan(const Dir: string; Recurse: Boolean);
|
||||
var
|
||||
currentPath: string;
|
||||
existingFile: IFileInfo;
|
||||
function TDirectoryMonitor.GetFiles(const Name: String): IFileInfo;
|
||||
begin
|
||||
if System.SysUtils.FindFirst(TPath.Combine(Dir, '*.*'), faAnyFile, sr) = 0 then
|
||||
try
|
||||
repeat
|
||||
if (sr.Name = '.') or (sr.Name = '..') then
|
||||
continue;
|
||||
|
||||
currentPath := TPath.Combine(Dir, sr.Name);
|
||||
if (sr.Attr and faDirectory) <> 0 then
|
||||
begin
|
||||
if Recurse then
|
||||
Scan(currentPath, true);
|
||||
end
|
||||
else if FileMatchesExtensions(currentPath, FExtensions) then
|
||||
begin
|
||||
foundFiles.Add(currentPath);
|
||||
FLock.Enter;
|
||||
try
|
||||
if not FFiles.TryGetValue(currentPath, existingFile) then
|
||||
begin
|
||||
FFiles.Add(currentPath, TFileInfo.Create(sr));
|
||||
(FFiles[currentPath] as TFileInfo).NotifyChanges(TFileState.Added);
|
||||
end
|
||||
else if (existingFile.Size <> sr.Size)
|
||||
or (Abs(existingFile.LastWriteTime - sr.TimeStamp) > (1 / SecsPerDay)) then
|
||||
begin
|
||||
FFiles.AddOrSetValue(currentPath, TFileInfo.Create(sr));
|
||||
(FFiles[currentPath] as TFileInfo).NotifyChanges(TFileState.Changed);
|
||||
end;
|
||||
if not FFiles.TryGetValue(Name, Result) then
|
||||
Result := nil;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
until System.SysUtils.FindNext(sr) <> 0;
|
||||
finally
|
||||
System.SysUtils.FindClose(sr);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
foundFiles := THashSet<String>.Create;
|
||||
keysToRemove := TList<string>.Create;
|
||||
try
|
||||
Scan(Watch.Directory, Watch.WatchSubtree);
|
||||
|
||||
rootPathWithDelim := IncludeTrailingPathDelimiter(Watch.Directory);
|
||||
|
||||
FLock.Enter;
|
||||
try
|
||||
for path in FFiles.Keys do
|
||||
begin
|
||||
// Check if the path is inside the directory tree we just scanned.
|
||||
if AnsiStartsText(rootPathWithDelim, path) and not foundFiles.Contains(path) then
|
||||
keysToRemove.Add(path);
|
||||
end;
|
||||
|
||||
for path in keysToRemove do
|
||||
begin
|
||||
var fileInfo: IFileInfo;
|
||||
if FFiles.TryGetValue(path, fileInfo) then
|
||||
begin
|
||||
(fileInfo as TFileInfo).NotifyChanges(TFileState.Deleted);
|
||||
FFiles.Remove(path);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
finally
|
||||
keysToRemove.Free;
|
||||
foundFiles.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.RescanAll;
|
||||
var
|
||||
watch: TDirectoryWatch;
|
||||
begin
|
||||
for watch in FDirectories do
|
||||
begin
|
||||
RescanDirectory(watch);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDirectoryMonitor.MonitorLoop;
|
||||
var
|
||||
handles: TArray<THandle>;
|
||||
notifyFilter: DWORD;
|
||||
i: Integer;
|
||||
waitResult: DWORD;
|
||||
begin
|
||||
SetLength(handles, Length(FDirectories));
|
||||
notifyFilter := TranslateChangeKinds();
|
||||
|
||||
for i := 0 to High(FDirectories) do
|
||||
begin
|
||||
handles[i] := FindFirstChangeNotification(PChar(FDirectories[i].Directory), FDirectories[i].WatchSubtree, notifyFilter);
|
||||
if handles[i] = INVALID_HANDLE_VALUE then
|
||||
begin
|
||||
FStopping := true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
while not FStopping do
|
||||
begin
|
||||
waitResult := WaitForMultipleObjects(Length(handles), @handles[0], FALSE, 500);
|
||||
|
||||
if FStopping then
|
||||
break;
|
||||
|
||||
case waitResult of
|
||||
WAIT_TIMEOUT: continue;
|
||||
WAIT_FAILED:
|
||||
begin
|
||||
FStopping := true;
|
||||
break;
|
||||
end;
|
||||
else
|
||||
if waitResult < WAIT_OBJECT_0 + Length(handles) then
|
||||
begin
|
||||
var changedIndex := waitResult - WAIT_OBJECT_0;
|
||||
// Rescan the specific directory that changed, directly in the worker thread.
|
||||
RescanDirectory(FDirectories[changedIndex]);
|
||||
|
||||
if not FindNextChangeNotification(handles[changedIndex]) then
|
||||
begin
|
||||
FStopping := true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
for i := 0 to High(handles) do
|
||||
begin
|
||||
if handles[i] <> INVALID_HANDLE_VALUE then
|
||||
FindCloseChangeNotification(handles[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDirectoryMonitor.GetFiles: TArray<IFileInfo>;
|
||||
function TDirectoryMonitor.GetFileCount: Integer;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FFiles.Values.ToArray;
|
||||
Result := FFiles.Count;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
@@ -513,17 +616,14 @@ begin
|
||||
try
|
||||
if not FFiles.TryGetValue(FileInfo.FullPath, currentFileInfo) then
|
||||
begin
|
||||
// Not in our cache, so from our perspective it's deleted.
|
||||
Result := TFileState.Deleted;
|
||||
end
|
||||
else if currentFileInfo = FileInfo then
|
||||
begin
|
||||
// The client holds the most current version from our cache.
|
||||
Result := TFileState.Unchanged;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// The client holds an older version; our cache has a newer one.
|
||||
Result := TFileState.Changed;
|
||||
end;
|
||||
finally
|
||||
@@ -544,7 +644,6 @@ begin
|
||||
try
|
||||
if FFiles.TryGetValue(OldFile.FullPath, NewFile) then
|
||||
begin
|
||||
// Found it in the cache. NewFile is now assigned.
|
||||
if NewFile = OldFile then
|
||||
Result := TFileState.Unchanged
|
||||
else
|
||||
@@ -552,7 +651,6 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Not in cache, so it's deleted. NewFile is already nil.
|
||||
Result := TFileState.Deleted;
|
||||
end;
|
||||
finally
|
||||
@@ -604,10 +702,4 @@ begin
|
||||
FExtensions.Clear;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GFactoryLock := TCriticalSection.Create;
|
||||
|
||||
finalization
|
||||
FreeAndNil(GFactoryLock);
|
||||
|
||||
end.
|
||||
|
||||
+2
-1
@@ -29,7 +29,8 @@ uses
|
||||
Myc.Trade.Node in '..\Src\Myc.Trade.Node.pas',
|
||||
Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas',
|
||||
Myc.Mutable in '..\Src\Myc.Mutable.pas',
|
||||
Test.Core.Mutable in 'Test.Core.Mutable.pas';
|
||||
Test.Core.Mutable in 'Test.Core.Mutable.pas',
|
||||
Tests.Myc.DirectoryMonitor in 'Tests.Myc.DirectoryMonitor.pas';
|
||||
|
||||
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
|
||||
@@ -130,6 +130,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="..\Src\Myc.Trade.DataStream.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Mutable.pas"/>
|
||||
<DCCReference Include="Test.Core.Mutable.pas"/>
|
||||
<DCCReference Include="Tests.Myc.DirectoryMonitor.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -27,9 +27,6 @@ type
|
||||
[Test]
|
||||
procedure TestFuncMutable_GetValue;
|
||||
|
||||
[Test]
|
||||
procedure TestFuncMutable_Signal;
|
||||
|
||||
[Test]
|
||||
[TestCase('Writeable', '10,20')]
|
||||
procedure TestWriteableMutable(InitialValue, NewValue: Integer);
|
||||
@@ -90,7 +87,7 @@ procedure TTestCoreMutable.TestNullMutable;
|
||||
var
|
||||
mutable: TMutable<Integer>;
|
||||
begin
|
||||
mutable := TMutable<Integer>.Create(TMycNullMutable<Integer>.Create(42));
|
||||
mutable := TMutable<Integer>.Constant(42);
|
||||
Assert.AreEqual(42, mutable.Value);
|
||||
// Explicitly cast record helper to fully qualified interface for comparison
|
||||
Assert.IsTrue(TSignal.ISignal(mutable.Changed) = TSignal.Null, 'Changed signal should be Null');
|
||||
@@ -115,25 +112,6 @@ begin
|
||||
Assert.AreEqual(1, callCount, 'Function should have been called once');
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestFuncMutable_Signal;
|
||||
var
|
||||
source: TEvent;
|
||||
mutable: TMutable<Integer>;
|
||||
lazy: TLazy<Integer>;
|
||||
func: TFunc<Integer>;
|
||||
begin
|
||||
source := TEvent.CreateEvent;
|
||||
func := function: Integer begin Result := 123; end;
|
||||
mutable := TMutable<Integer>.Construct(source.Signal, func);
|
||||
|
||||
lazy := TLazy<Integer>.Create(mutable);
|
||||
Assert.IsFalse(lazy.Update, 'Lazy wrapper should not detect a change initially.');
|
||||
|
||||
source.Notify;
|
||||
|
||||
Assert.IsTrue(lazy.Update, 'Lazy wrapper should detect the change after signal.');
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestWriteableMutable(InitialValue, NewValue: Integer);
|
||||
var
|
||||
writeable: TWriteable<Integer>;
|
||||
|
||||
Reference in New Issue
Block a user