Browse Source

* Dirwatch component

Michaël Van Canneyt 8 months ago
parent
commit
d3316831ca

+ 2 - 0
packages/fcl-base/fpmake.pp

@@ -144,6 +144,8 @@ begin
     P.InstallFiles.Add('src/win/fclel.res',AllWindowsOSes,'$(unitinstalldir)');
     P.InstallFiles.Add('src/win/fclel.res',AllWindowsOSes,'$(unitinstalldir)');
     T:=P.Targets.addUnit('basenenc.pp');
     T:=P.Targets.addUnit('basenenc.pp');
 
 
+    T:=P.Targets.addUnit('dirwatch.pp');
+
     // Examples
     // Examples
     P.ExamplePath.Add('examples');
     P.ExamplePath.Add('examples');
       T:=P.Targets.AddExampleProgram('asiotest.pp');
       T:=P.Targets.AddExampleProgram('asiotest.pp');

+ 770 - 0
packages/fcl-base/src/dirwatch.pp

@@ -0,0 +1,770 @@
+{ **********************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2024 by the Free Pascal development team
+
+    File/Directory watch component.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit dirwatch;
+
+{ $define forcegeneric}
+
+{$IFDEF FORCEGENERIC}
+{$DEFINE USEGENERIC}
+{$DEFINE USEDIRLIST}
+{$ELSE FORCEGENERIC}
+{$IFDEF LINUX}
+{$DEFINE USEINOTIFY}
+{$ELSE LINUX}
+{$IFDEF MSWINDOWS}
+{$DEFINE USEWINAPI}
+{$DEFINE USEDIRLIST}
+{$ELSE MSWINDOWS}
+{$IFDEF BSD}
+{$DEFINE USEKQUEUE}
+{$DEFINE USEDIRLIST}
+{$ELSE}
+{$DEFINE USEGENERIC}
+{$ENDIF BSD}
+{$ENDIF MSWINDOWS}
+{$ENDIF LINUX}
+{$ENDIF FORCEGENERIC}
+
+// Safety
+{$ifdef USEGENERIC}
+{$DEFINE USEDIRLIST}
+{$ENDIF}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}  
+  {$IFDEF USEDIRLIST}
+  System.Types, System.StrUtils,System.Contnrs,
+  {$ENDIF}
+  System.Classes, System.SysUtils;
+{$ELSE}
+  {$IFDEF USEDIRLIST}
+  types, strutils,contnrs,
+  {$ENDIF}
+  Classes, SysUtils;
+{$ENDIF}
+
+const
+  // Default check timeout
+  DefaultCheckTimeout = 10;
+  // Default loop interval
+  DefaultLoopInterval = 90;
+
+Type
+  TWatchFileEvent = (feModify,feAttrib,feCreate,feDelete);
+  TWatchFileEvents = set of TWatchFileEvent;
+  EDirWatch = Class(Exception);
+  TCustomDirwatch = Class;
+
+  { TWatchDirectoryEntry }
+  TWatchDirectoryEntry = Class(TCollectionItem)
+  private
+    FDriverData: TObject;
+    FEvents: TWatchFileEvents;
+    FPath: String;
+  Protected
+    function GetDisplayName: string; override;
+   // when set, it will be destroyed when this object is destroyed
+   Property DriverData : TObject Read FDriverData Write FDriverData;
+  Public
+    destructor destroy; override;
+  Published
+    // FileName/Dirname to watch. Relative to BaseDir
+    Property Path : String Read FPath Write FPath;
+    // Events to be notified of for this directory.
+    Property Events : TWatchFileEvents Read FEvents Write FEvents;
+  end;
+
+  { TWatchDirectoryEntries }
+
+  TWatchDirectoryEntries = Class(TCollection)
+  private
+    function GetE(AIndex : Integer): TWatchDirectoryEntry;
+    procedure SetE(AIndex : Integer; AValue: TWatchDirectoryEntry);
+  Public
+    Function IndexOfEntry(Const APath : String) : Integer;
+    function EntryByPath(const APath: String): TWatchDirectoryEntry;
+    Function AddEntry(Const APath : String) : TWatchDirectoryEntry;
+    Property Entries[AIndex : Integer] : TWatchDirectoryEntry Read GetE Write SetE; default;
+  end;
+
+  TFileChangeEvent = record
+    Entry : TWatchDirectoryEntry;
+    FileName : string;
+    Events : TWatchFileEvents;
+  end;
+
+  TWatchFileEventHandler = procedure (Sender : TObject; const aEvent : TFileChangeEvent) of Object;
+
+  { TDirWatchDriver }
+
+  TDirWatchDriver = Class(TObject)
+  private
+    FTerminate: Boolean;
+    FWatch: TCustomDirWatch;
+    FTerminated : Boolean;
+  protected
+    function DoCheck : cardinal; virtual; abstract;
+  public
+    Constructor Create(aWatch : TCustomDirwatch); virtual;
+    procedure Init; virtual; abstract;
+    procedure Done; virtual; abstract;
+    procedure Terminate;
+    function Check : cardinal;
+    property Watch : TCustomDirWatch read FWatch;
+    property Terminated : Boolean Read FTerminate;
+  end;
+  TDirWatchDriverClass = class of TDirwatchDriver;
+  { TDirwatch }
+
+  TNotifyCheckEvent = Procedure (sender: TObject; var aContinue : Boolean) of object;
+
+  { TCustomDirwatch }
+
+  TCustomDirwatch = Class(TComponent)
+  private
+    FCheckTimeout: Cardinal;
+    FLoopInterval: Cardinal;
+    FOnCheck: TNotifyCheckEvent;
+    FOnIdle: TNotifyEvent;
+    FOnIdleNotify: TNotifyEvent;
+    FTerminated: Boolean;
+    FThreaded: Boolean;
+    FWatches: TWatchDirectoryEntries;
+    FBaseDir: String;
+    FOnChange: TWatchFileEventHandler;
+    FDriver : TDirwatchDriver;
+    FInitOK : Boolean;
+    FDesignEnabled : Boolean;
+    FThread: TThread;
+    function GetEnabled: Boolean;
+    procedure SetBaseDir(AValue: String);
+    procedure SetEnabled(AValue: Boolean);
+    procedure SetThreaded(AValue: Boolean);
+  Protected
+    Class var
+       DefaultDriverClass : TDirwatchDriverClass;
+    procedure DoChangeEvent(const aEvent: TFileChangeEvent);
+    procedure DoIdle; virtual;
+    function DoCheck : cardinal; virtual;
+    procedure DoStartWatch; virtual;
+    procedure Loaded; override;
+    function DirectoryEntryForFileName(S: String): TWatchDirectoryEntry;
+  Public
+    Constructor Create(AOWner : TComponent); override;
+    Destructor Destroy; override;
+    procedure InitWatch; virtual;
+    procedure DoneWatch; virtual;
+    function Check : cardinal;
+    Procedure StartLoop;
+    Procedure AddWatch(const aFileName : string; aEvents : TWatchFileEvents);
+    Procedure Terminate;
+  Protected
+    // Was Terminate called ? If yes, the loop is stopped
+    Property Terminated : Boolean Read FTerminated;
+    // Set this to True to start the WatchLoop
+    property Enabled : Boolean Read GetEnabled write SetEnabled;
+    // Is the watch loop run in a thread ?
+    Property Threaded : Boolean Read FThreaded Write SetThreaded;
+    // Base directory. All filenames are relative to this directory. Setting it will clear watches.
+    Property BaseDir : String read FBaseDir Write SetBaseDir;
+    // Timeout when checking for changes.
+    Property CheckTimeout : Cardinal Read FCheckTimeout Write FCheckTimeout default DefaultCheckTimeout;
+    // Loop interval: interval between checks.
+    Property LoopInterval : Cardinal Read FLoopInterval Write FLoopInterval default DefaultLoopInterval;
+    // A list of directories or files to watch.
+    Property Watches : TWatchDirectoryEntries Read FWatches Write FWatches;
+    // Triggered when a change is detected.
+    Property OnChange : TWatchFileEventHandler Read FOnChange Write FOnChange;
+    // Called when loop is idle
+    Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdleNotify;
+    // Called before the check call is executed. If continue is set to false, the loop is terminated
+    Property OnCheck : TNotifyCheckEvent Read FOnCheck Write FOnCheck;
+  end;
+
+  TDirWatch = class(TCustomDirwatch)
+  Public
+    Property Terminated;
+  Published
+    property Enabled;
+    Property BaseDir;
+    Property OnChange;
+    Property Threaded;
+    Property Watches;
+    Property OnIdle;
+    Property OnCheck;
+    Property CheckTimeOut;
+  end;
+
+{$IFDEF USEDIRLIST}
+
+  TDirListDriver = Class(TDirWatchDriver)
+  Protected
+  Type
+    TDirData = class
+    Private
+      FEntry : TWatchDirectoryEntry;
+      FReference : TFPStringHashTable;
+      FInitDir : String;
+      FCount : Integer;
+      FWatch : TCustomDirwatch;
+    Protected
+      procedure ConstructList(const aBaseDir, aDir: String; aList: TFPStringHashTable);
+      procedure DoCheckItem(Item: String; const Key: string; var Continue: Boolean);
+      procedure DoDeletedItem(Item: String; const Key: string; var Continue: Boolean);
+      procedure InitWatch;
+      function Check : cardinal;
+    Public
+      constructor Create(aWatch : TCustomDirwatch; aEntry : TWatchDirectoryEntry);
+      Destructor Destroy; override;
+      Property Entry : TWatchDirectoryEntry Read FEntry;
+      Property Watch : TCustomDirwatch Read FWatch;
+    end;
+  end;
+
+Function SearchRecToString(Info : TSearchRec; AEvents : TWatchFileEvents) : String;
+
+{$ENDIF}
+
+Const
+  EventNames : Array[TWatchFileEvent] of string = ('Modify','Attrib','Create','Delete');
+  AllEvents =   [feModify,feAttrib,feCreate,feDelete];
+
+Function FileEventsToStr(Events : TWatchFileEvents) : String;
+
+implementation
+
+{$IFDEF USEINOTIFY}
+{$INCLUDE dwinotify.inc}
+{$ENDIF}
+{$IFDEF USEWINAPI}
+{$INCLUDE dwwinapi.inc}
+{$ENDIF}
+{$IFDEF USEGENERIC}
+{$INCLUDE dwgeneric.inc}
+{$ENDIF}
+{$IFDEF USEKQUEUE}
+{$INCLUDE dwkqueue.inc}
+{$ENDIF}
+
+
+Function FileEventsToStr(Events : TWatchFileEvents) : String;
+
+Var
+  E : TWatchFileEvent;
+
+begin
+  Result:='';
+  for E in Events do
+    begin
+    if Result<>'' then
+      Result:=Result+',';
+    Result:=Result+EventNames[E];
+    end;
+
+end;
+
+{ TCustomDirwatch }
+Type
+
+  { TCustomDirwatchThread }
+
+  TCustomDirwatchThread = class(TThread)
+  Private
+    FDir:TCustomDirwatch;
+  Public
+    Constructor Create(ADirwatch : TCustomDirwatch);
+    Procedure Execute; override;
+  end;
+
+
+
+
+{ TCustomDirwatchThread }
+
+constructor TCustomDirwatchThread.Create(ADirwatch: TCustomDirwatch);
+
+begin
+  FDir:=ADirWatch;
+  FreeOnTerminate:=True;
+  inherited create(False);
+end;
+
+procedure TCustomDirwatchThread.Execute;
+begin
+  FDir.DoStartWatch;
+end;
+
+
+procedure TCustomDirwatch.SetBaseDir(AValue: String);
+begin
+  if FBaseDir=AValue then Exit;
+  FBaseDir:=AValue;
+  FWatches.Clear;
+end;
+
+procedure TCustomDirwatch.SetEnabled(AValue: Boolean);
+begin
+  if (csDesigning in ComponentState) then
+    FDesignEnabled:=aValue
+  else
+    begin
+    if aValue then
+      begin
+      if not FInitOK then
+        StartLoop;
+      end
+    else
+      Terminate;
+    end;
+end;
+
+procedure TCustomDirwatch.SetThreaded(AValue: Boolean);
+begin
+  if FThreaded=AValue then Exit;
+  if FInitOK then
+    Raise EDirWatch.Create('Cannot change threaded after calling InitWatch');
+  FThreaded:=AValue;
+end;
+
+constructor TCustomDirwatch.Create(AOWner: TComponent);
+begin
+  inherited Create(AOWner);
+  FWatches:=TWatchDirectoryEntries.Create(TWatchDirectoryEntry);
+  FDriver:=DefaultDriverClass.Create(Self);
+  FCheckTimeOut:=DefaultCheckTimeout;
+  FLoopInterval:=DefaultLoopInterval;
+end;
+
+destructor TCustomDirwatch.Destroy;
+begin
+  if FInitOK then
+    begin
+    if Threaded then
+      Terminate;
+    DoneWatch;
+    end;
+  FreeAndNil(FDriver);
+  FreeAndNil(FWatches);
+  inherited Destroy;
+end;
+
+Type
+  { TCustomDirwatchChange }
+  TCustomDirwatchChange = Class
+    FDirWatch : TCustomDirwatch;
+    FEvent : TFileChangeEvent;
+    constructor Create(aDirWatch: TCustomDirwatch; aEvent: TFileChangeEvent);
+    Procedure DoEvent;
+ end;
+
+{ TCustomDirwatchChange }
+
+constructor TCustomDirwatchChange.Create(aDirWatch : TCustomDirwatch; aEvent: TFileChangeEvent);
+
+begin
+  FEvent:=aEvent;
+  FDirWatch:=ADirWatch;
+end;
+
+procedure TCustomDirwatchChange.DoEvent;
+
+begin
+  if not FDirWatch.Terminated then
+    FDirwatch.FonChange(FDirwatch,FEvent);
+end;
+
+procedure TCustomDirwatch.DoChangeEvent(const aEvent :TFileChangeEvent);
+
+Var
+  W : TCustomDirwatchChange;
+
+begin
+  if Assigned(FOnChange) then
+    if Not Threaded then
+      FonChange(Self,aEvent)
+    else
+      begin
+      W:=TCustomDirwatchChange.Create(Self,aEvent);
+      try
+        TThread.Synchronize(TThread.CurrentThread,@W.DoEvent)
+      finally
+        W.Free;
+      end;
+      end
+end;
+
+function TCustomDirwatch.GetEnabled: Boolean;
+begin
+  if csDesigning in ComponentState then
+    Result:=FDesignEnabled
+  else
+    Result:=FInitOK;
+end;
+
+
+procedure TCustomDirwatch.DoIdle;
+
+begin
+  if Assigned(FOnIdle) then
+    FOnIdle(Self);
+end;
+
+function TCustomDirwatch.Check : cardinal;
+var
+  Continue : Boolean;
+begin
+  Result:=0;
+  if not FInitOK then
+    InitWatch;
+  Continue:=True;
+  If Assigned(FOnCheck) then
+    FOnCheck(Self,Continue);
+  if Continue then
+    Result:=DoCheck
+  else
+    Terminate;
+end;
+
+function TCustomDirwatch.DoCheck: cardinal;
+begin
+  Result:=FDriver.Check;
+end;
+
+procedure TCustomDirwatch.DoneWatch;
+begin
+  if assigned(FDriver) then
+    FDriver.Done;
+  FInitOK:=False;
+end;
+
+
+function TCustomDirwatch.DirectoryEntryForFileName(S: String): TWatchDirectoryEntry;
+
+begin
+  Result:=FWatches.EntryByPath(S);
+  if (Result=Nil) then
+    Result:=FWatches.EntryByPath(ExtractFilePath(S));
+end;
+
+procedure TCustomDirwatch.DoStartWatch;
+
+begin
+  InitWatch;
+  try
+    While not Terminated do
+      begin
+      Check;
+      if not Terminated then
+        begin
+        if Threaded then
+          TThread.Synchronize(TThread.CurrentThread,@DoIdle)
+        else
+          DoIdle;
+        end;
+      if (LoopInterval>0) and not Terminated then
+        Sleep(LoopInterval);
+      end;
+  Finally
+    DoneWatch;
+  end;
+end;
+
+procedure TCustomDirwatch.Loaded;
+begin
+  inherited Loaded;
+  if FDesignEnabled then
+    StartLoop;
+end;
+
+procedure TCustomDirwatch.InitWatch;
+begin
+  FDriver.Init;
+  FInitOK:=True;
+  FTerminated:=False;
+end;
+
+procedure TCustomDirwatch.StartLoop;
+
+begin
+  If Threaded then
+    FThread:=TCustomDirwatchThread.Create(Self)
+  else
+    DoStartWatch;
+end;
+
+procedure TCustomDirwatch.AddWatch(const aFileName: string; aEvents: TWatchFileEvents);
+begin
+  FWatches.AddEntry(AFileName).Events:=AEvents;
+end;
+
+procedure TCustomDirwatch.Terminate;
+Var
+  lThread : TThread;
+begin
+  FDriver.Terminate;
+  FTerminated:=True;
+  if assigned(FThread) then
+    begin
+    lThread:=FThread;
+    FThread:=Nil;
+    TCustomDirwatchThread(lThread).FDir:=nil;
+    lThread.Terminate;
+    lThread.WaitFor;
+    end;
+end;
+
+function TWatchDirectoryEntry.GetDisplayName: string;
+begin
+  Result:=Path;
+end;
+
+destructor TWatchDirectoryEntry.destroy;
+begin
+  FreeAndNil(FDriverData);
+  inherited destroy;
+end;
+
+{ TWatchDirectoryEntries }
+
+function TWatchDirectoryEntries.GetE(AIndex : Integer): TWatchDirectoryEntry;
+begin
+  Result:=TWatchDirectoryEntry(Items[AIndex]);
+end;
+
+procedure TWatchDirectoryEntries.SetE(AIndex : Integer; AValue: TWatchDirectoryEntry);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TWatchDirectoryEntries.IndexOfEntry(const APath: String): Integer;
+
+begin
+  Result:=Count-1;
+  While (Result>=0) and (GetE(Result).Path<>APath) do
+    Dec(Result);
+end;
+
+function TWatchDirectoryEntries.EntryByPath(const APath: String): TWatchDirectoryEntry;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfEntry(APath);
+  If (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetE(I);
+end;
+
+function TWatchDirectoryEntries.AddEntry(Const APath: String): TWatchDirectoryEntry;
+begin
+  Result:=Add as TWatchDirectoryEntry;
+  Result.Path:=aPath;
+end;
+
+{ TCustomDirwatchDriver }
+
+constructor TDirWatchDriver.Create(aWatch: TCustomDirwatch);
+begin
+  FWatch:=aWatch;
+end;
+
+procedure TDirWatchDriver.Terminate;
+begin
+  FTerminated:=True;
+end;
+
+function TDirWatchDriver.Check: cardinal;
+begin
+  FTerminated:=False;
+  Result:=DoCheck;
+end;
+
+{$IFDEF USEDIRLIST}
+const
+  // Parts of string
+  pSize = 0;
+  pTime = 1;
+  pAttr = 2;
+
+Function SearchRecToString(Info : TSearchRec; AEvents : TWatchFileEvents) : String;
+
+begin
+  Result:=IntToStr(Info.Size)+';'+IntToStr(Info.Time)+';'+IntToStr(Info.Attr);
+end;
+
+constructor TDirListDriver.TDirData.Create(aWatch : TCustomDirwatch;aEntry: TWatchDirectoryEntry);
+begin
+  FWatch:=aWatch;
+  FEntry:=aEntry;
+end;
+
+destructor TDirListDriver.TDirData.Destroy;
+begin
+  FreeAndNil(FReference);
+  inherited Destroy;
+end;
+
+procedure TDirListDriver.TDirData.ConstructList(const aBaseDir,aDir: String; aList : TFPStringHashTable);
+
+var
+  Info : TSearchRec;
+  FN,FFN,RFN,ldata : String;
+begin
+  FN:=aDir+AllFilesMask;
+  if FindFirst(FN,faAnyFile,Info)=0 then
+    try
+      Repeat
+        FFN:=aDir+Info.Name;
+        RFN:=ExtractRelativePath(aBaseDir,FFN);
+        if (faDirectory and Info.Attr) = 0 then
+          begin
+          lData:=SearchRecToString(Info,FEntry.Events);
+          AList.Add(RFN,lData);
+          end
+      until FindNext(Info)<>0;
+    finally
+      Sysutils.FindClose(Info);
+    end;
+end;
+
+procedure TDirListDriver.TDirData.InitWatch;
+
+Var
+  FN : String;
+
+begin
+  if (Watch.BaseDir<>'') then
+    FN:=IncludeTrailingPathDelimiter(Watch.BaseDir)+Entry.Path
+  else
+    FN:=Entry.Path;
+  FReference:=TFPStringHashTable.Create;
+  ConstructList(FN,FN,FReference);
+  FInitDir:=FN;
+end;
+
+function TDirListDriver.TDirData.Check: Cardinal;
+
+var
+  FNew : TFPStringHashTable;
+
+begin
+  FCount:=0;
+  Result:=0;
+  FNew:=TFPStringHashTable.Create;
+  try
+    ConstructList(FInitDir,FInitDir,FNew);
+    if Watch.Terminated then
+      begin
+      FreeAndNil(FNew);
+      exit;
+      end;
+    // doCheckItem removes seen files from FReference
+    FNew.Iterate(@doCheckItem);
+    // Whatever is left in FReference was deleted
+    if FReference.Count>0 then
+      FReference.Iterate(@doDeletedItem);
+    FreeAndNil(FReference);
+    FReference:=FNew;
+    FNew:=Nil;
+  except
+    FNew.Free;
+    Raise;
+  end;
+  Result:=FCount;
+  FCount:=0;
+end;
+
+procedure TDirListDriver.TDirData.DoDeletedItem(Item: String; const Key: string; var Continue: Boolean);
+
+Var
+  lEvent : TFileChangeEvent;
+
+begin
+  lEvent.Entry:=Self.Entry;
+  lEvent.FileName:=Key;
+  lEvent.Events:=[feDelete];
+  Watch.DoChangeEvent(lEvent);
+  Inc(FCount);
+  Continue:=Not Watch.Terminated;
+end;
+
+procedure TDirListDriver.TDirData.DoCheckItem(Item: String; const Key: string; var Continue: Boolean);
+
+Var
+  S : String;
+  lNewParts,lOldParts : TStringDynArray;
+  E : TWatchFileEvents;
+  lInfo : TFileChangeEvent;
+
+begin
+  E:=[];
+  S:=FReference[Key];
+  if (S='') then
+    begin
+    E:=[feCreate];
+    end
+  else
+    begin
+    FReference.Delete(Key);
+    if (S<>Item) then
+      begin
+      lNewParts:=SplitString(Item,';');
+      lOldParts:=SplitString(S,';');
+      if (feAttrib in Entry.Events) then
+        if lNewParts[pAttr]<>lOldParts[pAttr] then
+          Include(E,feAttrib);
+      if (feModify in Entry.Events) then
+         begin
+         if (lNewParts[pTime]<>lOldParts[pTime]) or
+            (lNewParts[pSize]<>lOldParts[pSize]) then
+            Include(E,feModify);
+         end;
+      end;
+    end;
+  if E<>[] then
+    begin
+    Inc(FCount);
+    lInfo.Entry:=Entry;
+    lInfo.FileName:=Key;
+    lInfo.Events:=E;
+    Watch.DoChangeEvent(lInfo);
+    end;
+  Continue:=Not Watch.Terminated;
+end;
+
+{$ENDIF}
+
+initialization
+{$IFDEF USEGENERIC}
+  TCustomDirwatch.DefaultDriverClass:=TGenericDriver;
+{$ENDIF}
+{$IFDEF USEINOTIFY}
+  TCustomDirwatch.DefaultDriverClass:=TINotifyDriver;
+{$ENDIF}
+{$IFDEF USEWINAPI}
+  TCustomDirwatch.DefaultDriverClass:=TWinAPIDriver;
+{$ENDIF}
+{$IFDEF USEKQUEUE}
+  TCustomDirwatch.DefaultDriverClass:=TKQueueDriver;
+{$ENDIF}
+end.
+

+ 84 - 0
packages/fcl-base/src/dwgeneric.inc

@@ -0,0 +1,84 @@
+{ **********************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2024 by the Free Pascal development team
+
+    File/Directory watch component: generic implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Type
+  { TGenericDriver }
+
+  TGenericDriver = Class(TDirListDriver)
+  Public
+    Destructor destroy; Override;
+    Procedure Init; override;
+    function DoCheck : cardinal; override;
+    Procedure Done; override;
+  end;
+
+
+procedure TGenericDriver.Done;
+
+var
+  I : Integer;
+  D : TObject;
+
+begin
+  if not Assigned(Watch) then
+    exit;
+  For I:=0 to Watch.Watches.Count-1 do
+    begin
+    D:=Watch.Watches[i].DriverData;
+    Watch.Watches[i].DriverData:=Nil;
+    FreeAndNil(D);
+    end;
+
+end;
+
+destructor TGenericDriver.destroy;
+begin
+  Done;
+  inherited destroy;
+end;
+
+procedure TGenericDriver.Init;
+
+Var
+  I : Integer;
+  lData : TDirData;
+begin
+  For I:=0 to Watch.Watches.Count-1 do
+    begin
+    lData:=TDirData.Create(Watch,Watch.Watches[i]);
+    Watch.Watches[i].DriverData:=lData;
+    lData.InitWatch;
+    end;
+end;
+
+
+function TGenericDriver.DoCheck: cardinal;
+
+var
+  I : integer;
+  lData : TDirData;
+
+begin
+  Result:=0;
+  I:=0;
+  While (Not Terminated) and (I<Watch.Watches.Count) do
+    begin
+    lData:=TDirData(Watch.Watches[i].DriverData);
+    Result:=Result+LData.Check;
+    Inc(I);
+    end;
+end;
+
+

+ 191 - 0
packages/fcl-base/src/linux/dwinotify.inc

@@ -0,0 +1,191 @@
+{ **********************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2024 by the Free Pascal development team
+
+    File/Directory watch component: inotify implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  UnixApi.Base, System.CTypes, LinuxApi;
+{$ELSE}
+  baseunix,ctypes,linux;
+{$ENDIF}
+Type
+
+  { TINotifyData }
+
+  TINotifyData = Class(TObject)
+  private
+    FDescriptor: cInt;
+  public
+    Constructor create(aDescriptor : cint);
+    property Descriptor : cInt Read FDescriptor;
+  end;
+
+  { TINotifyDriver }
+
+  TINotifyDriver = Class(TDirwatchDriver)
+  Private
+    FINotifyFD : Cint;
+    function FindEntryFromDescriptor(Wd: Cint): TWatchDirectoryEntry;
+  protected
+    property INotifyFD : Cint Read FINotifyFD;
+  Public
+    Procedure Init; override;
+    function DoCheck : cardinal; override;
+    Procedure Done; override;
+  end;
+
+{ TINotifyData }
+
+constructor TINotifyData.create(aDescriptor: cint);
+begin
+  FDescriptor:=aDescriptor;
+end;
+
+procedure TINotifyDriver.Done;
+
+begin
+  fpClose(FInotifyFD);
+end;
+
+procedure TINotifyDriver.Init;
+
+Const
+  NativeEvents : Array[TWatchFileEvent] of cint = (IN_Modify,IN_Attrib,IN_Create,IN_Delete);
+
+Var
+  WD,I,NEvents : Integer;
+  E : TWatchFileEvent;
+  BD,FN : AnsiString;
+
+begin
+  BD:=Watch.BaseDir;
+  if BD<>'' then
+    BD:=IncludeTrailingPathDelimiter(BD);
+  FINotifyFD:=inotify_init;
+  For I:=0 to Watch.Watches.Count-1 do
+    begin
+    NEvents:=0;
+    for E in FWatch.Watches[i].Events do
+      NEvents:=NEvents OR NativeEvents[E];
+    FN:=BD+FWatch.Watches[i].Path;
+    wd:=inotify_add_watch(FINotifyFD,PAnsiChar(FN),NEvents);
+    if Assigned(FWatch.Watches[i].DriverData) then
+      TINotifyDAta(FWatch.Watches[i].DriverData).FDescriptor:=Wd
+    else
+      FWatch.Watches[i].DriverData:=TINotifyData.create(wd);
+    end;
+end;
+
+Function NativeEventsToEvents(Native : cint) : TWatchFileEvents;
+
+  Procedure MA(C : cint; AEvent : TWatchFileEvent);
+
+  begin
+    if (Native and C)<>0 then
+      Include(Result,AEvent);
+  end;
+
+begin
+  Result:=[];
+  MA(IN_ACCESS,feAttrib);
+  MA(IN_MODIFY,feModify);
+  MA(IN_ATTRIB,feAttrib);
+  MA(IN_CLOSE_WRITE,feAttrib);
+  MA(IN_CLOSE_NOWRITE,feAttrib);
+  MA(IN_OPEN,feAttrib);
+  MA(IN_MOVED_FROM,feCreate);
+  MA(IN_MOVED_TO,feDelete);
+  MA(IN_CREATE,feCreate);
+  Ma(IN_DELETE,feDelete);
+  Ma(IN_DELETE_SELF,feDelete);
+  Ma(IN_MOVE_SELF,feDelete);
+  Ma(IN_UNMOUNT,feDelete);
+  // IN_Q_OVERFLOW
+  // IN_IGNORED
+
+end;
+
+function TINotifyDriver.FindEntryFromDescriptor(Wd : Cint) : TWatchDirectoryEntry;
+
+ Function IsMatch(W : TWatchDirectoryEntry): boolean;
+ begin
+   Result:=Assigned(W) and (W.DriverData is TINotifyData) and (TINotifyData(W.DriverData).Descriptor=wd);
+ end;
+
+var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  I:=Watch.Watches.Count-1;
+  While (I>=0) and not IsMatch(Watch.Watches[i]) do
+    Dec(I);
+  if I>=0 then
+    Result:=Watch.Watches[i];
+end;
+
+function TINotifyDriver.DoCheck: cardinal;
+
+Type
+  TINotifyBuffer = Array[0..1023*4] of Byte;  // 4K Buffer
+
+Var
+  fnl,len : cint;
+  e : ^inotify_event;
+  buf : TINotifyBuffer;
+  fn : ansistring;
+  p : pansichar;
+  fds : tfdset;
+  Timeout : ttimeval;
+  lEvent : TFileChangeEvent;
+
+begin
+  Result:=0;
+  Buf:=Default(TINotifyBuffer);
+  fn:='';
+  fpFD_Zero(fds);
+  fpFD_SET(FINotifyFD,fds);
+  timeout.tv_sec:=FWatch.CheckTimeOut div 1000;
+  timeout.tv_usec:=(FWatch.CheckTimeOut mod 1000)*1000;
+  if (fpSelect(FINotifyFD+1,@fds,nil,nil,@Timeout)<=0) then
+    exit;
+  len:=fpRead(FINotifyFD,buf,sizeof(buf));
+  e:=@buf;
+  While ((pansichar(e)-pansichar(@buf))<len) do
+    begin
+    fnl:=e^.len;
+    if (fnl>0) then
+      begin
+      p:=@e^.name+fnl-1;
+      While (p^=#0) do
+        begin
+        dec(p);
+        dec(fnl);
+        end;
+      end;
+    setlength(fn,fnl);
+    if (fnl>0) then
+      move(e^.name,fn[1],fnl);
+    lEvent.FileName:=FN;
+    lEvent.Entry:=FindEntryFromDescriptor(E^.wd);
+    if (lEvent.Entry=Nil) then
+      lEvent.Entry:=Watch.DirectoryEntryForFileName(FN);
+    lEvent.Events:=NativeEventsToEvents(E^.mask);
+    Watch.DoChangeEvent(lEvent);
+    PByte(e):=PByte(e)+sizeof(inotify_event)+e^.len-1;
+    Inc(Result);
+    end;
+end;
+
+

+ 165 - 0
packages/fcl-base/src/unix/dwkqueue.inc

@@ -0,0 +1,165 @@
+{ **********************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2024 by the Free Pascal development team
+
+    File/Directory watch component: KQueue based implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  UnixApi.Types, UnixApi.Base, BsdApi;
+{$ELSE}
+  unixtype,baseunix,bsd;
+{$ENDIF}
+
+
+{ TKQueueDriver }
+Type
+
+
+  TKQueueDriver = Class(TDirListDriver)
+  Protected
+  Type
+
+    { TKQueueData }
+
+    TKQueueData = class(TDirData)
+    private
+      FFd: cint;
+    public
+      Constructor create(aFd : cint; aWatch : TCustomDirwatch; aEntry : TWatchDirectoryEntry);
+      Destructor destroy;override;
+      Property FD : cint Read FFd;
+    end;
+  Private
+    FKQueue : cint;
+    FKEvents : Array of TKEvent;
+  private
+    class function EventsToFLags(const aEvents: TWatchFileEvents): cuint;
+  Public
+    Destructor destroy; Override;
+    Procedure Init; override;
+    function DoCheck : cardinal; override;
+    Procedure Done; override;
+  end;
+
+{ TKQueueData }
+
+constructor TKQueueDriver.TKQueueData.create(aFd: cint; aWatch : TCustomDirwatch; aEntry : TWatchDirectoryEntry);
+begin
+  Inherited create(aWatch,aEntry);
+  FFd:=aFd;
+end;
+
+destructor TKQueueDriver.TKQueueData.destroy;
+begin
+  fpClose(FFd);
+  inherited destroy;
+end;
+
+destructor TKQueueDriver.destroy;
+begin
+  Done;
+  inherited destroy;
+end;
+
+class function TKQueueDriver.EventsToFLags(const aEvents : TWatchFileEvents) : cuint;
+begin
+  Result:=0;
+  Result:=Result or NOTE_WRITE or NOTE_EXTEND or NOTE_DELETE OR NOTE_RENAME OR NOTE_ATTRIB;
+end;
+
+procedure TKQueueDriver.Init;
+var
+  i,lCount : Integer;
+  fd : cInt;
+  lData : TKQueueData;
+  BD,FN : String;
+  lFlags : cuint;
+  lEntry : TWatchDirectoryEntry;
+
+begin
+  lCount:=0;
+  FKQueue:=kQueue;
+  if FKQueue=-1 then
+    Raise EDirWatch.Create('Failed to create kernel queue');
+  BD:= Watch.BaseDir;
+  if BD<>'' then
+    BD:=IncludeTrailingPathDelimiter(BD);
+  For I:=0 to Watch.Watches.count-1 do
+    begin
+    lEntry:=Watch.Watches[i];
+    FN:=BD+lEntry.Path;
+    fd:=fpopen(FN,O_RDONLY {or O_DIRECTORY});
+    if fd<>-1 then
+      begin
+      lData:=TKQueueData.create(fd,Watch,lEntry);
+      Watch.Watches[i].DriverData:=lData;
+      lData.InitWatch;
+      inc(lCount);
+      end;
+    end;
+  SetLength(FKevents,lCount);
+  lCount:=0;
+  For I:=0 to Watch.Watches.Count-1 do
+    begin
+    lEntry:=Watch.Watches[i];
+    lData:=TKQueueData(lEntry.DriverData);
+    if assigned(lData) then
+      begin
+      lFlags:=EventsToFlags(lEntry.Events);
+      EV_SET(@FKevents[lCount],lData.FD,EVFILT_VNODE, EV_ADD or EV_CLEAR, lFlags,0,lData);
+      inc(lCount);
+      end;
+    end;
+  DoCheck;
+end;
+
+function TKQueueDriver.DoCheck: cardinal;
+var
+  lEvents: Array of TKEvent;
+  timeout : Ttimespec;
+  i,lCount : cInt;
+  lData : TKQueueData;
+
+begin
+  Result:=0;
+  lEvents:=[];
+  SetLength(lEvents,Length(FKevents)*2);
+  timeout.tv_sec:=FWatch.CheckTimeOut div 1000;
+  timeout.tv_nsec:=(FWatch.CheckTimeOut mod 1000)*1000*1000;
+  lCount:=kevent(FKQueue,PKEvent(FKEvents),Length(FKevents),PKevent(lEvents),Length(lEvents),@Timeout);
+  For I:=0 to lCount-1 do
+    begin
+    lData:=TKQueueData(lEvents[i].uData);
+    if Assigned(lData) then
+      Result:=Result+LData.Check;
+    end;
+end;
+
+procedure TKQueueDriver.Done;
+var
+  I : Integer;
+  D : TObject;
+
+begin
+  if Assigned(Watch) then
+    For I:=0 to Watch.Watches.Count-1 do
+      begin
+      D:=Watch.Watches[i].DriverData;
+      Watch.Watches[i].DriverData:=Nil;
+      FreeAndNil(D);
+      end;
+  fpclose(FKQueue);
+  FKEvents:=[];
+  FKQueue:=0;
+end;

+ 170 - 0
packages/fcl-base/src/win/dwwinapi.inc

@@ -0,0 +1,170 @@
+{%MainUnit dirwatch.pp}
+{ **********************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2024 by the Free Pascal development team
+
+    File/Directory watch component: winapi implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses WinApi.Windows;
+{$ELSE}
+uses windows;
+{$ENDIF}
+
+const
+  DefaultGracePeriod = 10; // Number of milliseconds to wait after findfirstnotificationchange returns
+
+{ TWinAPIDriver }
+
+Type
+
+
+  TWinAPIDriver = Class(TDirListDriver)
+  Type
+    { TWinAPIWatchData }
+    TWinAPIData = class(TDirData)
+    private
+      FHandle: THandle;
+    Public
+      constructor Create(aHandle : THandle; aWatch : TCustomDirwatch; aEntry : TWatchDirectoryEntry);
+      Property Handle : THandle Read FHandle;
+    end;
+  Private
+    FGracePeriod: Integer;
+    FHandles : Array of THandle;
+  protected
+    Function FindDataForHandle(aHandle : THandle) : TWinAPIData;
+  Public
+    Procedure Init; override;
+    function DoCheck : cardinal; override;
+    Procedure Done; override;
+    Property GracePeriod : Integer Read FGracePeriod;
+  end;
+
+constructor TWinAPIDriver.TWinAPIData.Create(aHandle: THandle; aWatch : TCustomDirwatch; aEntry : TWatchDirectoryEntry);
+begin
+  Inherited Create(aWatch,aEntry);
+  FHandle:=aHandle;
+end;
+
+Function EventsToNotifyFilters(Events : TWatchFileEvents) : DWord;
+begin
+  Result:=0;
+  if ([feCreate,feDelete] * Events)<>[] then
+    Result:=Result or FILE_NOTIFY_CHANGE_FILE_NAME;
+  if (feAttrib in Events) then
+    Result:=Result or FILE_NOTIFY_CHANGE_ATTRIBUTES;
+  if (feModify in Events) then
+    Result:=Result or FILE_NOTIFY_CHANGE_LAST_WRITE;
+end;
+
+function TWinAPIDriver.FindDataForHandle(aHandle: THandle): TWinAPIData;
+var
+  I : integer;
+begin
+  Result:=Nil;
+  I:=0;
+  While (Result=Nil) and (I<Watch.Watches.Count) do
+    begin
+    Result:=TWinAPIData(Watch.Watches[i].DriverData);
+    if Assigned(Result) and (Result.Handle<>aHandle) then
+      Result:=Nil;
+    Inc(I);
+    end;
+end;
+
+procedure TWinAPIDriver.Init;
+var
+  lCount,I : Integer;
+  BD,FN : String;
+  lFilters : DWord;
+  lEntry : TWatchDirectoryEntry;
+  lHandle : THandle;
+  lData : TWinAPIData;
+
+begin
+  FGracePeriod:=DefaultGracePeriod;
+  lCount:=0;
+  BD:=Watch.BaseDir;
+  if BD<>'' then
+    BD:=IncludeTrailingPathDelimiter(BD);
+  For I:=0 to Watch.Watches.Count-1 do
+    begin
+    LEntry:=Watch.Watches[i];
+    FN:=BD+lEntry.Path;
+    lFilters:=EventsToNotifyFilters(lEntry.Events);
+    lHandle := FindFirstChangeNotification(PAnsiChar(FN), False, lFilters);
+    if (lHandle<>INVALID_HANDLE_VALUE) then
+      begin
+      lData:=TWinAPIData.Create(lHandle,Watch,lEntry);
+      lEntry.DriverData:=lData;
+      lData.InitWatch;
+      inc(lCount);
+      end;
+    end;
+  SetLength(FHandles,lCount);
+  if lCount=0 then
+    exit;
+  lCount:=0;
+  For I:=0 to Watch.Watches.Count-1 do
+    if assigned(Watch.Watches[i].DriverData) then
+      begin
+      FHandles[lCount]:=TWinAPIData(Watch.Watches[i].DriverData).Handle;
+      Inc(lCount);
+      end;
+end;
+
+function TWinAPIDriver.DoCheck: cardinal;
+
+var
+  Idx : Integer;
+  H : THandle;
+  Res : DWord;
+  lData : TWinAPIData;
+
+begin
+  Result:=0;
+  Res:=WaitForMultipleObjects(Length(FHandles),PWOHandleArray(FHandles),False,Watch.CheckTimeOut);
+  Idx:=(Res-WAIT_OBJECT_0);
+  if ((IDx>=0) and (Idx<Length(FHandles))) then
+    begin
+    // Empty queue
+    H:=FHandles[Idx];
+    repeat
+      FindNextChangeNotification(H);
+    until Terminated or (WaitForSingleObject(H,GracePeriod) <> WAIT_OBJECT_0);
+    lData:=FindDataForHandle(H);
+    Result:=Result+lData.Check;
+    end;
+end;
+
+procedure TWinAPIDriver.Done;
+
+var
+  I : integer;
+  Obj : TObject;
+  lHandle : TWinAPIData absolute Obj;
+
+begin
+  For I:=0 to Watch.Watches.Count-1 do
+    if assigned(Watch.Watches[i].DriverData) then
+      begin
+      Obj:=Watch.Watches[i].DriverData;
+      Watch.Watches[i].DriverData:=Nil;
+      if Assigned(lHandle) then
+        begin
+        FindCloseChangeNotification(lHandle.Handle);
+        lHandle.Free;
+        end;
+      end;
+end;
+

+ 13 - 1
packages/fcl-base/tests/fclbase-unittests.lpi

@@ -36,7 +36,7 @@
         </Mode0>
         </Mode0>
       </Modes>
       </Modes>
     </RunParams>
     </RunParams>
-    <Units Count="8">
+    <Units Count="11">
       <Unit0>
       <Unit0>
         <Filename Value="fclbase-unittests.pp"/>
         <Filename Value="fclbase-unittests.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -69,6 +69,18 @@
         <Filename Value="tccsvdocument.pp"/>
         <Filename Value="tccsvdocument.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit7>
       </Unit7>
+      <Unit8>
+        <Filename Value="utcchainstream.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="utclzw.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="utdirwatch.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit10>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 288 - 0
packages/fcl-base/tests/utdirwatch.pas

@@ -0,0 +1,288 @@
+unit utdirwatch;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, dirwatch;
+
+type
+  TChangedEntry = record
+    Dir : TWatchDirectoryEntry;
+    Events : TWatchFileEvents;
+    FN : String;
+  end;
+  TChangedEntryArray = Array of TChangedEntry;
+
+  { TTestDirWatch }
+
+  TTestDirWatch= class(TTestCase)
+  private
+    FDirWatch: TDirwatch;
+    FTestDir: string;
+    FChanged: TChangedEntryArray;
+    FCheckCount : Integer;
+    FMaxLoopCount : Integer;
+    FDoCheckOne : TNotifyEvent;
+    procedure AssertChange(const Msg: String; aIndex: Integer; aEntry: TWatchDirectoryEntry; aEvents: TWatchFileEvents; const aFileName : string = '');
+    procedure CleanDirs(aDir: String);
+    procedure DoAppendFile(const aName: string);
+    procedure DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
+    procedure DoCheck(sender: TObject; var aContinue: Boolean);
+    procedure DoCreateFile(const aName: string);
+    procedure DoDeleteFile(const aName: string);
+    procedure HandleCreateFile(Sender: TObject);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    property dirwatch : TDirwatch read FDirWatch;
+    Property TestDir : string Read FTestDir;
+    property CheckCount : Integer Read FCheckCount;
+    property MaxLoopCount : Integer Read FMaxLoopCount Write FMaxLoopCount;
+  Public
+    class procedure AssertEquals(const Msg: String; aExpected, aActual: TWatchFileEvents); overload;
+  published
+    procedure TestHookUp;
+    procedure TestAddFile;
+    procedure TestAppendFile;
+    procedure TestDeleteFile;
+    procedure TestLoopNoThread;
+    procedure TestLoopThread;
+    procedure TestAddFileBaseDir;
+  end;
+
+implementation
+
+uses typinfo, inifiles;
+
+var
+  BaseDir : String;
+
+procedure TTestDirWatch.CleanDirs(aDir: String);
+
+Var
+  Info : TSearchRec;
+  lDir,lFull : String;
+
+begin
+  lDir:=IncludeTrailingPathDelimiter(aDir);
+  If FIndFirst(lDir+AllFilesMask,sysutils.faDirectory,Info)=0 then
+    try
+      Repeat
+        lFull:=lDir+Info.Name;
+        if (Info.Attr and faDirectory)<>0 then
+          begin
+          if not ((Info.Name='.') or (Info.Name='..')) then
+            begin
+            CleanDirs(lFull);
+            if not RemoveDir(lFull) then
+              Fail('Failed to remove directory %s',[lFull])
+            end;
+          end
+        else if not DeleteFIle(lFull) then
+          Fail('Failed to remove file %s',[lFull])
+      until FIndNext(Info)<>0;
+    finally
+      FindClose(Info);
+    end;
+end;
+
+procedure TTestDirWatch.DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
+var
+  Len : Integer;
+begin
+  len:=Length(FChanged);
+  SetLength(FChanged,Len+1);
+  FChanged[Len].Dir:=aEvent.Entry;
+  FChanged[Len].Events:=aEvent.Events;
+  FChanged[Len].FN:=aEvent.FileName;
+end;
+
+procedure TTestDirWatch.DoCheck(sender: TObject; var aContinue: Boolean);
+begin
+  aContinue:=CheckCount<MaxLoopCount;
+  if (FCheckCount=0) then
+    if Assigned(FDoCheckOne) then
+       FDoCheckOne(Self);
+  inc(FCheckCount);
+end;
+
+procedure TTestDirWatch.TestHookUp;
+begin
+  AssertNotNull('Have watch',Dirwatch);
+  AssertEquals('No watches',0,Dirwatch.Watches.Count);
+  AssertTrue('Have test dir',TestDir<>'');
+  AssertTrue('test dir exists',DirectoryExists(TestDir));
+  AssertEquals('No max check count',0,FMaxLoopCount);
+  AssertEquals('No check count',0,FCheckCount);
+  AssertTrue('No docheckone',FDoCheckOne=nil);
+end;
+
+procedure TTestDirWatch.DoAppendFile(const aName : string);
+
+var
+  FD : THandle;
+begin
+  FD:=FileOpen(TestDir+aName,fmOpenWrite);
+  try
+    FileSeek(FD,0,fsFromEnd);
+    if FileWrite(FD,aName[1],Length(aName))=-1 then
+      Writeln(GetLastOSError);
+  finally
+    FileClose(FD);
+  end;
+end;
+
+procedure TTestDirWatch.DoCreateFile(const aName : string);
+
+var
+  L: TStrings;
+begin
+  L:=TStringList.Create;
+  try
+    L.Add(aName);
+    L.SaveToFile(TestDir+aName);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestDirWatch.DoDeleteFile(const aName: string);
+
+begin
+  If not DeleteFile(TestDir+aName) then
+    Fail('Failed to delete file '+TestDir+aName);
+end;
+
+procedure TTestDirWatch.HandleCreateFile(Sender: TObject);
+begin
+  DoCreateFile('name.txt');
+end;
+
+class procedure TTestDirWatch.AssertEquals(const Msg: String; aExpected,aActual : TWatchFileEvents);
+
+begin
+  AssertEquals(Msg,SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aExpected),False),
+                   SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aActual),False));
+end;
+
+procedure TTestDirWatch.AssertChange(const Msg: String; aIndex: Integer; aEntry: TWatchDirectoryEntry; aEvents: TWatchFileEvents;
+  const aFileName: string);
+var
+  M : String;
+begin
+  M:=Msg+Format(' [%d]: ',[aIndex]);
+  AssertTrue(M+'correct index',aIndex<Length(FChanged));
+  AssertSame(M+'correct dir entry',aEntry,FChanged[aIndex].Dir);
+  AssertEquals(M+'correct changes',aEvents,FChanged[aIndex].Events);
+  if aFileName<>'' then
+    AssertEquals(M+'correct fileName',aFileName,FChanged[aIndex].FN);
+end;
+
+procedure TTestDirWatch.TestAddFile;
+begin
+  FDirwatch.AddWatch(TestDir,[feCreate]);
+  FDirWatch.InitWatch;
+  DoCreateFile('name.txt');
+  AssertEquals(1,FDirWatch.Check);
+  AssertChange('Create',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+end;
+
+procedure TTestDirWatch.TestAppendFile;
+begin
+  FDirwatch.AddWatch(TestDir,[feModify]);
+  DoCreateFile('name.txt');
+  FDirWatch.InitWatch;
+  DoAppendFile('name.txt');
+  AssertEquals('Change detected',1,FDirWatch.Check);
+  AssertChange('Change detected',0,FDirWatch.Watches[0],[feModify],'name.txt');
+end;
+
+
+procedure TTestDirWatch.TestDeleteFile;
+begin
+  FDirwatch.AddWatch(TestDir,[feDelete]);
+  DoCreateFile('name.txt');
+  FDirWatch.InitWatch;
+  DoDeleteFile('name.txt');
+  AssertEquals('Change detected',1,FDirWatch.Check);
+  AssertChange('Change detected',0,FDirWatch.Watches[0],[feDelete],'name.txt');
+end;
+
+procedure TTestDirWatch.TestLoopNoThread;
+begin
+  FDirwatch.AddWatch(TestDir,[feCreate]);
+  FDirwatch.OnCheck:=@DoCheck;
+  FDoCheckOne:=@HandleCreateFile;
+  MaxLoopCount:=2;
+  FDirWatch.StartLoop;
+  AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+end;
+
+procedure TTestDirWatch.TestLoopThread;
+var
+  I : Integer;
+begin
+  FDirwatch.AddWatch(TestDir,[feCreate]);
+  FDirwatch.Threaded:=True;
+  FDirWatch.StartLoop;
+  Sleep(50);
+  DoCreateFile('name.txt');
+  I:=0;
+  Repeat
+    Sleep(10);
+    CheckSynchronize;
+    inc(i);
+  until (I>=50) or (length(FChanged)>0);
+  AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+end;
+
+procedure TTestDirWatch.TestAddFileBaseDir;
+begin
+  FDirwatch.BaseDir:=TestDir;
+  AssertTrue('Create Subdir ',ForceDirectories(TestDir+'sub'));
+  FDirwatch.AddWatch('',[feCreate]);
+  FDirWatch.InitWatch;
+  DoCreateFile('sub/name.txt');
+  AssertEquals('Subdirs not watched',0,FDirWatch.Check);
+end;
+
+procedure TTestDirWatch.SetUp;
+begin
+  FDirWatch:=TDirwatch.Create(Nil);
+  FTestDir:=IncludeTrailingPathDelimiter(BaseDir);
+  ForceDirectories(TestDir);
+  FDirWatch.OnChange:=@DoChange;
+  FMaxLoopCount:=0;
+  FCheckCount:=0;
+  FDoCheckOne:=Nil;
+end;
+
+procedure TTestDirWatch.TearDown;
+begin
+  CleanDirs(TestDir);
+  FDirWatch.Free;
+end;
+
+procedure GetBaseDir;
+
+var
+  FN : string;
+begin
+  BaseDir:=IncludeTrailingPathDelimiter(GetTempDir)+'Dirwatch'+PathDelim;
+  FN:=ExtractFilePath(ParamStr(0))+'config.ini';
+  If FileExists(FN) then
+    With TMemIniFile.Create(FN) do
+      try
+        BaseDir:=ReadString('dirwatch','basedir',BaseDir);
+      finally
+        Free;
+      end;
+end;
+
+initialization
+  GetBaseDir;
+  RegisterTest(TTestDirWatch);
+end.
+