unit Myc.DirectoryMonitor; 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 ['{D6B3E3B3-5A27-4E2F-8E3B-1B4F29D8E7C5}'] // Never remove this line! It is just for the LSP. {$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 ['{A1B2C3D4-E5F6-A7B8-C9D0-E1F2A3B4C5D6}'] // Never remove this line! It is just for the LSP. {$region 'private'} function GetFiles: TArray; {$endregion} // Retrieves a snapshot of the currently known files. property Files: TArray read GetFiles; // 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 ['{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. 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 DirectoryMonitorFactory: IDirectoryMonitorFactory; implementation uses Winapi.Windows, System.Classes, System.IOUtils, System.Generics.Collections, System.SyncObjs, System.StrUtils; type // Concrete implementation of IFileInfo TFileInfo = class(TInterfacedObject, IFileInfo) private FFullPath: string; FFileName: string; FExtension: string; FCreationTime: TDateTime; FLastWriteTime: TDateTime; FSize: Int64; FNotifyList: TMycNotifyList; // Stores TFunc after casting function GetFullPath: string; function GetFileName: string; function GetExtension: string; function GetCreationTime: TDateTime; function GetLastWriteTime: TDateTime; function GetSize: Int64; public constructor Create(const SearchRec: TSearchRec); procedure AddChangeNotification(const ChangeNotification: TFunc); procedure NotifyChanges(NewState: TFileState); end; TDirectoryWatch = record Directory: string; WatchSubtree: Boolean; end; // Concrete implementation of IDirectoryMonitor TDirectoryMonitor = class(TInterfacedObject, IDirectoryMonitor) private FDirectories: TArray; FExtensions: TArray; FChangeKinds: TFileChangeKinds; FFiles: TObjectDictionary; FLock: TCriticalSection; FThreadState: TState; FStopping: Boolean; procedure RescanDirectory(const Watch: TDirectoryWatch); procedure MonitorLoop; procedure RescanAll; function TranslateChangeKinds: DWORD; class function FileMatchesExtensions(const FileName: string; const Extensions: TArray): Boolean; static; function GetFiles: TArray; 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; var GFactory: IDirectoryMonitorFactory; GFactoryLock: TCriticalSection; function DirectoryMonitorFactory: 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; end; { TFileInfo } constructor TFileInfo.Create(const SearchRec: TSearchRec); begin inherited Create; FFullPath := SearchRec.Name; FFileName := TPath.GetFileName(SearchRec.Name); FExtension := TPath.GetExtension(SearchRec.Name); FCreationTime := SearchRec.CreationTime; FLastWriteTime := SearchRec.TimeStamp; // TSearchRec.Time is deprecated! FSize := SearchRec.Size; end; procedure TFileInfo.AddChangeNotification(const ChangeNotification: TFunc); begin // Store the function reference as a plain IInterface. We will cast it back upon notification. FNotifyList.Advise(TFunc(ChangeNotification) as IInterface); end; procedure TFileInfo.NotifyChanges(NewState: TFileState); begin FNotifyList.Notify( function(const Obj: IInterface): Boolean var func: TFunc; begin // Cast back from IInterface to the actual function type func := TFunc(Obj); Result := func(Self, NewState); 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 ); begin inherited Create; FDirectories := Directories; FExtensions := Extensions; FChangeKinds := ChangeKinds; FStopping := false; FLock := TCriticalSection.Create; FFiles := TObjectDictionary.Create([doOwnsValues]); // Perform a robust initial scan to populate the file list RescanAll; // Start the background monitoring thread FThreadState := TaskManager.CreateThread(MonitorLoop); end; destructor TDirectoryMonitor.Destroy; begin // Signal the monitoring thread to stop FStopping := true; // Wait for the thread to terminate gracefully TaskManager.WaitFor(FThreadState); FLock.Enter; try FreeAndNil(FFiles); finally FLock.Leave; end; FreeAndNil(FLock); inherited; 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; procedure TDirectoryMonitor.RescanDirectory(const Watch: TDirectoryWatch); var foundFiles: THashSet; path: string; sr: TSearchRec; keysToRemove: TList; rootPathWithDelim: string; procedure Scan(const Dir: string; Recurse: Boolean); var currentPath: string; existingFile: 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; finally FLock.Leave; end; end; until System.SysUtils.FindNext(sr) <> 0; finally System.SysUtils.FindClose(sr); end; end; begin foundFiles := THashSet.Create; keysToRemove := TList.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; 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; begin FLock.Enter; try Result := FFiles.Values.ToArray; 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 // 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 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 // Found it in the cache. NewFile is now assigned. if NewFile = OldFile then Result := TFileState.Unchanged else Result := TFileState.Changed; end else begin // Not in cache, so it's deleted. NewFile is already nil. 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; initialization GFactoryLock := TCriticalSection.Create; finalization FreeAndNil(GFactoryLock); end.