Detecting file changes using file watching thread

An application can monitor the contents of a file by using change notifications.

unit  FileWatch;

interface

uses
  Windows, SysUtils, Classes;

type
  TFileWatch = class(TThread)
  private
    FFileName     : string;
    FOnFileChanged: TNotifyEvent;
    FHandle       : THandle;
    FLastTime     : TFileTime;
    FActive       : boolean;
    procedure ReleaseHandle;
    procedure AllocateHandle;
    procedure SetFileName(const Value: String);
  protected
    procedure Execute; override;
    procedure Notify;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Suspend;
    procedure Resume;
    procedure Reset;
  published
    property OnNotify: TNotifyEvent read FOnFileChanged write FOnFileChanged;
    property FileName: String read FFileName write SetFileName;
    property LastTime: TFileTime read FLastTime write FLastTime;
    property Active: boolean read FActive write FActive;
  end;

implementation

resourcestring
  SErrAllocHandle = 'Could not allocate notification object.' + #13#10 + '%d: %s';

function GetFileLastWrite(const FileName: string): TFileTime;
var
  r: TSearchRec;
begin
  if FindFirst(FileName, faAnyFile, r) = 0 then begin
    SysUtils.FindClose(r);
    Result := r.FindData.ftLastWriteTime;
  end else begin
    Result.dwLowDateTime := 0;
    Result.dwHighDateTime := 0;
  end;
end;

function SameFileTime(t1, t2: TFileTime): boolean;
begin
  Result := (t1.dwHighDateTime = t2.dwHighDateTime) and
    (t1.dwLowDateTime = t2.dwLowDateTime);
end;

{ TFileWatch }

constructor TFileWatch.Create;
begin
  inherited Create(false);
  FreeOnTerminate := false;
  FActive := true;
  Priority := tpLowest;
end;

destructor TFileWatch.Destroy;
begin
  ReleaseHandle;
  inherited Destroy;
end;

procedure TFileWatch.Suspend;
begin
  ReleaseHandle;
  FActive := false;
  inherited Suspend;
end;

procedure TFileWatch.Resume;
begin
  AllocateHandle;
  FActive := true;
  FLastTime := GetFileLastWrite(FFileName);   // Get the latest filetime
  inherited Resume;
end;

procedure TFileWatch.Notify;
begin
  if not SameFileTime(FLastTime, GetFileLastWrite(FFileName)) then begin
    if FActive then begin
      ReleaseHandle;
      if Assigned(FOnFileChanged) then FOnFileChanged(Self);
    end;
    FLastTime := GetFileLastWrite(FFileName);   // Get the latest filetime
    if FActive then AllocateHandle;
  end;
end;

procedure TFileWatch.SetFileName(const Value :String);
begin
  if not SameText(Value, FFileName) then begin
    FFileName := Value;
    FLastTime := GetFileLastWrite(Value);
    Reset;
  end;
end;

procedure TFileWatch.Execute;
begin
  while not Terminated do begin
    if FHandle <> 0 then begin
      if WaitForSingleObject(FHandle, 500) = WAIT_OBJECT_0 then
      begin
        Synchronize(Notify);
        FindNextChangeNotification(FHandle);
      end;
    end else
      Sleep(10);   
  end;
end;

procedure TFileWatch.ReleaseHandle;
begin
  FindCloseChangeNotification(FHandle);
  FHandle := 0;
end;

procedure TFileWatch.AllocateHandle;
  function DoAllocate: THandle;
  var
    ie: integer;
    se: string;
    Folder : string;
  begin
    Folder := ExcludeTrailingPathDelimiter(ExtractFilePath(FFileName));
    if Folder = '' then
      Folder := GetCurrentDir;

    Result := FindFirstChangeNotification(PChar(Folder), Bool(0),
      FILE_NOTIFY_CHANGE_LAST_WRITE);
    if Result = INVALID_HANDLE_VALUE then
    begin
      ie := GetLastError;
      se := Format(SErrAllocHandle, [ie, SysErrorMessage(ie)]);
      raise Exception.Create(se);
    end;
  end;
begin
  try
    if FileExists(FFileName) then
      FHandle := DoAllocate
    else
      FHandle := 0;        // File doesn't exist anymore
  except
    ReleaseHandle;
    raise;
  end;
end;

procedure TFileWatch.Reset;
begin
  ReleaseHandle;
  if FileExists(FFileName) then begin
    FLastTime := GetFileLastWrite(FFileName);   // Get the latest filetime
    AllocateHandle;
  end;
end;


end.

Comments

Popular posts from this blog

Quricol - QR code generator library

Smir - backup and restore Windows desktop icons position

EIDNative Library 2.0 released