Directory-Monitor
This commit is contained in:
@@ -12,7 +12,8 @@ uses
|
|||||||
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas',
|
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas',
|
||||||
Myc.FMX.Chart.Series in '..\Src\Myc.FMX.Chart.Series.pas',
|
Myc.FMX.Chart.Series in '..\Src\Myc.FMX.Chart.Series.pas',
|
||||||
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.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}
|
{$R *.res}
|
||||||
|
|
||||||
|
|||||||
@@ -141,6 +141,7 @@
|
|||||||
<DCCReference Include="..\Src\Myc.FMX.Chart.Series.pas"/>
|
<DCCReference Include="..\Src\Myc.FMX.Chart.Series.pas"/>
|
||||||
<DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/>
|
<DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/>
|
||||||
<DCCReference Include="..\Src\Myc.Trade.Types.pas"/>
|
<DCCReference Include="..\Src\Myc.Trade.Types.pas"/>
|
||||||
|
<DCCReference Include="..\Src\Myc.DirectoryMonitor.pas"/>
|
||||||
<BuildConfiguration Include="Base">
|
<BuildConfiguration Include="Base">
|
||||||
<Key>Base</Key>
|
<Key>Base</Key>
|
||||||
</BuildConfiguration>
|
</BuildConfiguration>
|
||||||
@@ -184,6 +185,12 @@
|
|||||||
<Overwrite>true</Overwrite>
|
<Overwrite>true</Overwrite>
|
||||||
</Platform>
|
</Platform>
|
||||||
</DeployFile>
|
</DeployFile>
|
||||||
|
<DeployFile LocalName="Win64\Debug\AuraTrader.rsm" Configuration="Debug" Class="DebugSymbols">
|
||||||
|
<Platform Name="Win64">
|
||||||
|
<RemoteName>AuraTrader.rsm</RemoteName>
|
||||||
|
<Overwrite>true</Overwrite>
|
||||||
|
</Platform>
|
||||||
|
</DeployFile>
|
||||||
<DeployFile LocalName="Win64\Release\AuraTrader.exe" Configuration="Release" Class="ProjectOutput">
|
<DeployFile LocalName="Win64\Release\AuraTrader.exe" Configuration="Release" Class="ProjectOutput">
|
||||||
<Platform Name="Win64">
|
<Platform Name="Win64">
|
||||||
<RemoteName>AuraTrader.exe</RemoteName>
|
<RemoteName>AuraTrader.exe</RemoteName>
|
||||||
|
|||||||
@@ -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<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.
|
||||||
@@ -14,6 +14,7 @@ type
|
|||||||
procedure CreateThread(const Proc: TProc);
|
procedure CreateThread(const Proc: TProc);
|
||||||
procedure RunTask(const Gate: TState; const Proc: TProc);
|
procedure RunTask(const Gate: TState; const Proc: TProc);
|
||||||
procedure WaitFor(const State: TState);
|
procedure WaitFor(const State: TState);
|
||||||
|
function InWorkerThread: Boolean;
|
||||||
end;
|
end;
|
||||||
private
|
private
|
||||||
FTaskManager: ITaskManager;
|
FTaskManager: ITaskManager;
|
||||||
@@ -27,8 +28,16 @@ type
|
|||||||
// Returns a State to await thread completion.
|
// Returns a State to await thread completion.
|
||||||
function CreateThread(const Proc: TProc): TState;
|
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.
|
// Run a task when the gate is opened.
|
||||||
// Returns a State to await thread completion.
|
// Returns a State to await thread completion.
|
||||||
|
// No blocking operations are allowed whithin tasks!
|
||||||
function RunTask(const Proc: TFunc<TState>): TState; overload;
|
function RunTask(const Proc: TFunc<TState>): TState; overload;
|
||||||
function RunTask(const Gate: TState; const Proc: TFunc<TState>): TState; overload;
|
function RunTask(const Gate: TState; const Proc: TFunc<TState>): TState; overload;
|
||||||
procedure RunTask(const Gate: TState; const Proc: TProc); overload;
|
procedure RunTask(const Gate: TState; const Proc: TProc); overload;
|
||||||
@@ -62,6 +71,7 @@ procedure SetupTaskManagerMock;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
|
System.Classes,
|
||||||
Myc.Core.Tasks;
|
Myc.Core.Tasks;
|
||||||
|
|
||||||
type
|
type
|
||||||
@@ -79,6 +89,7 @@ type
|
|||||||
procedure RunTask(const Gate: TState; const Proc: TProc);
|
procedure RunTask(const Gate: TState; const Proc: TProc);
|
||||||
procedure WaitFor(const State: TState);
|
procedure WaitFor(const State: TState);
|
||||||
procedure CreateThread(const Proc: TProc);
|
procedure CreateThread(const Proc: TProc);
|
||||||
|
function InWorkerThread: Boolean;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TMycExecMock }
|
{ TMycExecMock }
|
||||||
@@ -111,6 +122,11 @@ begin
|
|||||||
Proc();
|
Proc();
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TMycTaskManagerMock.InWorkerThread: Boolean;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TMycTaskManagerMock.RunTask(const Gate: TState; const Proc: TProc);
|
procedure TMycTaskManagerMock.RunTask(const Gate: TState; const Proc: TProc);
|
||||||
begin
|
begin
|
||||||
Gate.Signal.Subscribe(TMycExecMock.Create(Proc));
|
Gate.Signal.Subscribe(TMycExecMock.Create(Proc));
|
||||||
@@ -151,6 +167,31 @@ begin
|
|||||||
);
|
);
|
||||||
end;
|
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<Integer, TState>): TState;
|
class function TTaskManager.RunSequence(const Gate: TState; First, Count: Integer; const Proc: TFunc<Integer, TState>): TState;
|
||||||
begin
|
begin
|
||||||
if First >= Count then
|
if First >= Count then
|
||||||
|
|||||||
Reference in New Issue
Block a user