MycLib/Src/Myc.DirectoryMonitor.pas

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<IFileInfo, TFileState, Boolean>);
    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<IFileInfo>;
        {$endregion}

        // Retrieves a snapshot of the currently known files.
        property Files: TArray<IFileInfo> 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<IInterface>; // Stores TFunc<IFileInfo, TFileState, Boolean> 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<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;

        FFiles: TObjectDictionary<string, IFileInfo>;
        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<string>): Boolean; static;

        function GetFiles: TArray<IFileInfo>;
    public
        constructor Create(const Directories: TArray<TDirectoryWatch>; const Extensions: TArray<string>; 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<TDirectoryWatch>;
        FExtensions: TList<string>;
        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<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);
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
    );
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<TDirectoryWatch>;
    const Extensions: TArray<string>;
    ChangeKinds: TFileChangeKinds
);
begin
    inherited Create;
    FDirectories := Directories;
    FExtensions := Extensions;
    FChangeKinds := ChangeKinds;
    FStopping := false;
    FLock := TCriticalSection.Create;
    FFiles := TObjectDictionary<string, IFileInfo>.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<string>): 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<String>;
    path: string;
    sr: TSearchRec;
    keysToRemove: TList<string>;
    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<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>;
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<TDirectoryWatch>.Create;
    FExtensions := TList<string>.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.