MycLib/Src/Myc.DirectoryMonitor.pas

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<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
        {$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<Byte>;
    end;

    // Concrete implementation of IFileInfo
    TFileInfo = class(TInterfacedObject, IFileInfo)
    private
        FFullPath: string;
        FFileName: string;
        FExtension: string;
        FCreationTime: TDateTime;
        FLastWriteTime: TDateTime;
        FSize: Int64;
        FNotifyList: TMycNotifyList<TFunc<IFileInfo, TFileState, Boolean>>;

        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<IFileInfo, TFileState, Boolean>);
        procedure NotifyChanges(NewState: TFileState);
    end;

    // Concrete implementation of IDirectoryMonitor
    TDirectoryMonitor = class(TInterfacedObject, IDirectoryMonitor)
    private
        FExtensions: TArray<string>;
        FChangeKinds: TFileChangeKinds;
        FWatchInfos: TArray<TWatchInfo>;

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

        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;

        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;

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<IFileInfo, TFileState, Boolean>);
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<IFileInfo, TFileState, Boolean>): 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<TDirectoryWatch>;
    const Extensions: TArray<string>;
    ChangeKinds: TFileChangeKinds
);
var
    i: Integer;
    watch: TDirectoryWatch;
begin
    inherited Create;
    FExtensions := Extensions;
    FChangeKinds := ChangeKinds;
    FLock := TCriticalSection.Create;
    FFiles := TDictionary<string, IFileInfo>.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<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;
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;

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<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;

end.