unit Myc.DirectoryMonitor experimental; interface uses System.SysUtils, Myc.Core.Notifier, Myc.TaskManager, Myc.Signals; type // What kind of changes to monitor TFileChangeKind = ( FileNameChange, // A file name has been created, renamed, or deleted. DirNameChange, // A directory name has been created, renamed, or deleted. AttributeChange, // File or directory attributes have changed. SizeChange, // File size has changed. LastWriteChange, // Last write time of a file or directory has changed. SecurityChange // Security descriptor of a file or directory has changed. ); TFileChangeKinds = set of TFileChangeKind; TFileState = ( Unchanged, // The file exists and has not changed since the last check. Deleted, // The file has been deleted since the last check. Changed, // The file has been modified (e.g., size, write time) since the last check. Added // The file is new since the last check. ); // Represents a single file and its properties. IFileInfo = interface {$region 'private'} function GetFullPath: string; function GetFileName: string; function GetExtension: string; function GetCreationTime: TDateTime; function GetLastWriteTime: TDateTime; function GetSize: Int64; {$endregion} // The full path of the file. property FullPath: string read GetFullPath; // The name of the file including the extension. property FileName: string read GetFileName; // The extension of the file. property Extension: string read GetExtension; // The creation timestamp of the file. property CreationTime: TDateTime read GetCreationTime; // The last modification timestamp of the file. property LastWriteTime: TDateTime read GetLastWriteTime; // The size of the file in bytes. property Size: Int64 read GetSize; // Client may hook in here for change notifications. // If ChangeNotification returns false, it will be removed from the notify list. procedure AddChangeNotification(const ChangeNotification: TFunc); end; TSubDirectoryHandling = ( Ignore, // Only monitor the specified directory. Recursive // Monitor the specified directory and all its subdirectories. ); // Monitors directories for file changes. IDirectoryMonitor = interface {$region 'private'} function GetFiles(const Name: String): IFileInfo; function GetFileCount: Integer; {$endregion} // Retrieves a snapshot of the currently known files. 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; // Attempts to find an updated version of a given file info object. function TryFindNewVersion(const OldFile: IFileInfo; out NewFile: IFileInfo): TFileState; end; // Factory for creating directory monitors. IDirectoryMonitorFactory = interface // 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. procedure AddExtension(const Extension: string); // Sets the kinds of changes to monitor. procedure SetChangeKinds(const ChangeKinds: TFileChangeKinds); // Creates the monitor instance based on the provided configuration. function CreateMonitor: IDirectoryMonitor; end; function CreateDirectoryMonitorFactory: IDirectoryMonitorFactory; implementation uses Winapi.Windows, System.Classes, System.IOUtils, System.Generics.Collections, 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; end; // Concrete implementation of IFileInfo TFileInfo = class(TInterfacedObject, IFileInfo) private FFullPath: string; FFileName: string; FExtension: string; FCreationTime: TDateTime; FLastWriteTime: TDateTime; FSize: Int64; FNotifyList: TMycNotifyList>; function GetFullPath: string; function GetFileName: string; function GetExtension: string; function GetCreationTime: TDateTime; function GetLastWriteTime: TDateTime; function GetSize: Int64; public constructor Create(const AFullPath: string; const SearchRec: TSearchRec); procedure AddChangeNotification(const ChangeNotification: TFunc); procedure NotifyChanges(NewState: TFileState); end; // Concrete implementation of IDirectoryMonitor TDirectoryMonitor = class(TInterfacedObject, IDirectoryMonitor) private FExtensions: TArray; FChangeKinds: TFileChangeKinds; FWatchInfos: TArray; FFiles: TDictionary; FLock: TCriticalSection; FThreadState: TState; FStopEvent: THandle; procedure InitialScan(const WatchInfo: TWatchInfo); procedure MonitorLoop; 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): Boolean; static; function GetFiles(const Name: String): IFileInfo; function GetFileCount: Integer; public constructor Create(const Directories: TArray; const Extensions: TArray; ChangeKinds: TFileChangeKinds); destructor Destroy; override; function CheckState(const FileInfo: IFileInfo): TFileState; function TryFindNewVersion(const OldFile: IFileInfo; out NewFile: IFileInfo): TFileState; end; // Concrete implementation of IDirectoryMonitorFactory TDirectoryMonitorFactory = class(TInterfacedObject, IDirectoryMonitorFactory) private FDirectories: TList; FExtensions: TList; FChangeKinds: TFileChangeKinds; public constructor Create; destructor Destroy; override; procedure AddDirectory(const DirPath: string; SubDirHandling: TSubDirectoryHandling); procedure AddExtension(const Extension: string); procedure SetChangeKinds(const ChangeKinds: TFileChangeKinds); function CreateMonitor: IDirectoryMonitor; end; function CreateDirectoryMonitorFactory: IDirectoryMonitorFactory; begin Result := TDirectoryMonitorFactory.Create; end; { TFileInfo } constructor TFileInfo.Create(const AFullPath: string; const SearchRec: TSearchRec); begin inherited Create; FFullPath := AFullPath; FFileName := TPath.GetFileName(AFullPath); FExtension := TPath.GetExtension(AFullPath); FCreationTime := SearchRec.CreationTime; FLastWriteTime := SearchRec.TimeStamp; FSize := SearchRec.Size; end; procedure TFileInfo.AddChangeNotification(const ChangeNotification: TFunc); begin FNotifyList.Lock; try FNotifyList.Advise(ChangeNotification); finally FNotifyList.Release; end; end; procedure TFileInfo.NotifyChanges(NewState: TFileState); begin FNotifyList.Lock; try FNotifyList.Notify(function(const Func: TFunc): Boolean begin Result := Func(Self, NewState); end); finally FNotifyList.Release; end; end; function TFileInfo.GetCreationTime: TDateTime; begin Result := FCreationTime; end; function TFileInfo.GetExtension: string; begin Result := FExtension; end; function TFileInfo.GetFileName: string; begin Result := FFileName; end; function TFileInfo.GetFullPath: string; begin Result := FFullPath; end; function TFileInfo.GetLastWriteTime: TDateTime; begin Result := FLastWriteTime; end; function TFileInfo.GetSize: Int64; begin Result := FSize; end; { TDirectoryMonitor } constructor TDirectoryMonitor.Create( const Directories: TArray; const Extensions: TArray; ChangeKinds: TFileChangeKinds ); var i: Integer; watch: TDirectoryWatch; begin inherited Create; FExtensions := Extensions; FChangeKinds := ChangeKinds; FLock := TCriticalSection.Create; FFiles := TDictionary.Create; FStopEvent := CreateEvent(nil, TRUE, FALSE, nil); 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; FThreadState := TaskManager.CreateThread(MonitorLoop); end; destructor TDirectoryMonitor.Destroy; var info: TWatchInfo; begin // Signal the monitoring thread to stop. SetEvent(FStopEvent); // 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 Scan(WatchInfo.Directory); finally FLock.Leave; end; end; procedure TDirectoryMonitor.MonitorLoop; var handles: TArray; 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; begin Result := 0; if TFileChangeKind.FileNameChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_FILE_NAME; if TFileChangeKind.DirNameChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_DIR_NAME; if TFileChangeKind.AttributeChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_ATTRIBUTES; if TFileChangeKind.SizeChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_SIZE; if TFileChangeKind.LastWriteChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_LAST_WRITE; if TFileChangeKind.SecurityChange in FChangeKinds then Result := Result or FILE_NOTIFY_CHANGE_SECURITY; end; class function TDirectoryMonitor.FileMatchesExtensions(const FileName: string; const Extensions: TArray): Boolean; var ext: string; fileExt: string; begin if (Length(Extensions) = 0) or ((Length(Extensions) = 1) and (Extensions[0] = '*')) then exit(true); fileExt := TPath.GetExtension(FileName); for ext in Extensions do begin if SameText(fileExt, ext) then exit(true); end; Result := false; end; function TDirectoryMonitor.GetFiles(const Name: String): IFileInfo; begin FLock.Enter; try if not FFiles.TryGetValue(Name, Result) then Result := nil; finally FLock.Leave; end; end; function TDirectoryMonitor.GetFileCount: Integer; begin FLock.Enter; try Result := FFiles.Count; finally FLock.Leave; end; end; function TDirectoryMonitor.CheckState(const FileInfo: IFileInfo): TFileState; var currentFileInfo: IFileInfo; begin if not Assigned(FileInfo) then begin Result := TFileState.Deleted; exit; end; FLock.Enter; try if not FFiles.TryGetValue(FileInfo.FullPath, currentFileInfo) then begin Result := TFileState.Deleted; end else if currentFileInfo = FileInfo then begin Result := TFileState.Unchanged; end else begin Result := TFileState.Changed; end; finally FLock.Leave; end; end; function TDirectoryMonitor.TryFindNewVersion(const OldFile: IFileInfo; out NewFile: IFileInfo): TFileState; begin NewFile := nil; if not Assigned(OldFile) then begin Result := TFileState.Deleted; exit; end; FLock.Enter; try if FFiles.TryGetValue(OldFile.FullPath, NewFile) then begin if NewFile = OldFile then Result := TFileState.Unchanged else Result := TFileState.Changed; end else begin Result := TFileState.Deleted; end; finally FLock.Leave; end; end; { TDirectoryMonitorFactory } constructor TDirectoryMonitorFactory.Create; begin inherited; FDirectories := TList.Create; FExtensions := TList.Create; FChangeKinds := [TFileChangeKind.FileNameChange, TFileChangeKind.LastWriteChange, TFileChangeKind.SizeChange, TFileChangeKind.DirNameChange]; end; destructor TDirectoryMonitorFactory.Destroy; begin FreeAndNil(FDirectories); FreeAndNil(FExtensions); inherited; end; procedure TDirectoryMonitorFactory.AddDirectory(const DirPath: string; SubDirHandling: TSubDirectoryHandling); var watch: TDirectoryWatch; begin watch.Directory := TPath.GetFullPath(DirPath); watch.WatchSubtree := (SubDirHandling = TSubDirectoryHandling.Recursive); FDirectories.Add(watch); end; procedure TDirectoryMonitorFactory.AddExtension(const Extension: string); begin FExtensions.Add(Extension); end; procedure TDirectoryMonitorFactory.SetChangeKinds(const ChangeKinds: TFileChangeKinds); begin FChangeKinds := ChangeKinds; end; function TDirectoryMonitorFactory.CreateMonitor: IDirectoryMonitor; begin Result := TDirectoryMonitor.Create(FDirectories.ToArray, FExtensions.ToArray, FChangeKinds); FDirectories.Clear; FExtensions.Clear; end; end.