From 208006c896ff1726932c4b5ec5bfa999f06e0520 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 17 Jul 2025 10:30:08 +0200 Subject: [PATCH] Directory-Monitor --- AuraTrader/AuraTrader.dpr | 3 +- AuraTrader/AuraTrader.dproj | 7 + Src/Myc.DirectoryMonitor.pas | 613 +++++++++++++++++++++++++++++++++++ Src/Myc.TaskManager.pas | 41 +++ 4 files changed, 663 insertions(+), 1 deletion(-) create mode 100644 Src/Myc.DirectoryMonitor.pas diff --git a/AuraTrader/AuraTrader.dpr b/AuraTrader/AuraTrader.dpr index 1a532d2..037fea5 100644 --- a/AuraTrader/AuraTrader.dpr +++ b/AuraTrader/AuraTrader.dpr @@ -12,7 +12,8 @@ uses Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas', Myc.FMX.Chart.Series in '..\Src\Myc.FMX.Chart.Series.pas', Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas', - Myc.Trade.Types in '..\Src\Myc.Trade.Types.pas'; + Myc.Trade.Types in '..\Src\Myc.Trade.Types.pas', + Myc.DirectoryMonitor in '..\Src\Myc.DirectoryMonitor.pas'; {$R *.res} diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj index f68fd0b..c73e8c8 100644 --- a/AuraTrader/AuraTrader.dproj +++ b/AuraTrader/AuraTrader.dproj @@ -141,6 +141,7 @@ + Base @@ -184,6 +185,12 @@ true + + + AuraTrader.rsm + true + + AuraTrader.exe diff --git a/Src/Myc.DirectoryMonitor.pas b/Src/Myc.DirectoryMonitor.pas new file mode 100644 index 0000000..3465b4a --- /dev/null +++ b/Src/Myc.DirectoryMonitor.pas @@ -0,0 +1,613 @@ +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. diff --git a/Src/Myc.TaskManager.pas b/Src/Myc.TaskManager.pas index cb05cec..ab35f9e 100644 --- a/Src/Myc.TaskManager.pas +++ b/Src/Myc.TaskManager.pas @@ -14,6 +14,7 @@ type procedure CreateThread(const Proc: TProc); procedure RunTask(const Gate: TState; const Proc: TProc); procedure WaitFor(const State: TState); + function InWorkerThread: Boolean; end; private FTaskManager: ITaskManager; @@ -27,8 +28,16 @@ type // Returns a State to await thread completion. function CreateThread(const Proc: TProc): TState; + // Synchronize from independent thread (created by CreateThread). This is a blocking function and it will + // raise an exception, if it is called called from a task (created by RunTask). + procedure Synchronize(const Proc: TProc); + + // true, if called from a task (created by RunTask) + function InTask: Boolean; + // Run a task when the gate is opened. // Returns a State to await thread completion. + // No blocking operations are allowed whithin tasks! function RunTask(const Proc: TFunc): TState; overload; function RunTask(const Gate: TState; const Proc: TFunc): TState; overload; procedure RunTask(const Gate: TState; const Proc: TProc); overload; @@ -62,6 +71,7 @@ procedure SetupTaskManagerMock; implementation uses + System.Classes, Myc.Core.Tasks; type @@ -79,6 +89,7 @@ type procedure RunTask(const Gate: TState; const Proc: TProc); procedure WaitFor(const State: TState); procedure CreateThread(const Proc: TProc); + function InWorkerThread: Boolean; end; { TMycExecMock } @@ -111,6 +122,11 @@ begin Proc(); end; +function TMycTaskManagerMock.InWorkerThread: Boolean; +begin + Result := false; +end; + procedure TMycTaskManagerMock.RunTask(const Gate: TState; const Proc: TProc); begin Gate.Signal.Subscribe(TMycExecMock.Create(Proc)); @@ -151,6 +167,31 @@ begin ); end; +function TTaskManager.InTask: Boolean; +begin + Result := FTaskManager.InWorkerThread; +end; + +procedure TTaskManager.Synchronize(const Proc: TProc); +begin + if InTask then + raise Exception.Create('Synchronization in tasks not allowed'); + + var cProc := Proc; + if Assigned(cProc) then + TThread.Synchronize( + nil, + procedure + begin + if Assigned(cProc) then + begin + cProc(); + cProc := nil; + end; + end + ); +end; + class function TTaskManager.RunSequence(const Gate: TState; First, Count: Integer; const Proc: TFunc): TState; begin if First >= Count then