path: root/Medley/src/lib/other/DirWatch.pas

unit DirWatch;

// -----------------------------------------------------------------------------
// Component Name:  TDirectoryWatch                                            .
// Module:          DirWatch                                                   .
// Description:     Implements watching for file changes in a designated       .
//                  directory (or directories).                                .
// Version:         1.4                                                        .
// Date:            10-MAR-2003                                                .
// Target:          Win32, Delphi 3 - Delphi 7                                 .
// Author:          Angus Johnson, angusj-AT-myrealbox-DOT-com                 .
//                  A portion of code has been copied from the Drag & Drop     .
//                  Component Suite which I co-authored with Anders Melander.  .
// Copyright:       � 2003 Angus Johnson                                       .
//                                                                             .
// Usage:           1. Add a TDirectoryWatch component to your form.           .
//                  2. Set its Directory property                              .
//                  3. If you wish to watch its subdirectories too then set    .
//                  the WatchSubDir property to true                           .
//                  4. Assign the OnChange event                               .
//                  5. Set Active to true                                      .
// -----------------------------------------------------------------------------

interface

{$IFDEF FPC}
  {$MODE Delphi}
  {$H+} // use long strings
{$ENDIF}

uses
  Windows,
  Messages,
  Classes,
  {$IFDEF FPC}
  WinAllocation,
  {$ENDIF}
  SysUtils;

type
  TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib,
    nfSize, nfLastWrite, nfSecurity);

  TWatchThread = class;             //forward declaration

  TDirectoryWatch = class(TComponent)
  private
    fWindowHandle: THandle;
    fWatchThread: TWatchThread;
    fWatchSubDirs: boolean;
    fDirectory: string;
    fActive: boolean;
    fNotifyFilters: TNotifyFilters; //see FindFirstChangeNotification in winAPI
    fOnChangeEvent: TNotifyEvent;
    procedure SetActive(aActive: boolean);
    procedure SetDirectory(aDir: string);
    procedure SetWatchSubDirs(aWatchSubDirs: boolean);
    procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters);
    procedure WndProc(var aMsg: TMessage);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Directory: string read fDirectory write SetDirectory;
    property NotifyFilters: TNotifyFilters
      read fNotifyFilters write SetNotifyFilters;
    property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs;
    property Active: boolean read fActive write SetActive;
    property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent;
  end;

  TWatchThread = class(TThread)
  private
    fOwnerHdl: Thandle;
    fChangeNotify : THandle; //Signals whenever Windows detects a change in    .
                             //the watched directory                           .
    fBreakEvent: THandle;    //Signals when either the Directory property      .
                             //changes or when the thread terminates           .
    fDirectory: string;
    fWatchSubDirs: longbool;
    fNotifyFilters: dword;
    fFinished: boolean;    
  protected
    procedure SetDirectory(const Value: string);
    procedure ProcessFilenameChanges;
    procedure Execute; override;
  public
    constructor Create( OwnerHdl: THandle;
      const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
    destructor Destroy; override;
    procedure Terminate;
    property Directory: string write SetDirectory;
  end;

procedure Register;

implementation

const
  NOTIFYCHANGE_MESSAGE = WM_USER + 1;

resourcestring
  sInvalidDir = 'Invalid Directory: ';

//----------------------------------------------------------------------------
// Miscellaneous functions ...
//----------------------------------------------------------------------------

procedure Register;
begin
  RegisterComponents('Samples', [TDirectoryWatch]);
end;
//----------------------------------------------------------------------------

function DirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

//----------------------------------------------------------------------------
// TDirectoryWatch methods ...
//----------------------------------------------------------------------------

constructor TDirectoryWatch.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  //default Notify values - notify if either a file name or a directory name
  //changes or if a file is modified ...
  fNotifyFilters := [nfFilename, nfDirname, nfLastWrite];
  fDirectory := 'C:\';
  //this non-visual control needs to handle messages, so ...
  if not (csDesigning in ComponentState) then
    fWindowHandle := AllocateHWnd(WndProc);
end;
//----------------------------------------------------------------------------

destructor TDirectoryWatch.Destroy;
begin
  Active := false;
  if not (csDesigning in ComponentState) then
    DeallocateHWnd(fWindowHandle);
  inherited Destroy;
end;
//----------------------------------------------------------------------------

procedure TDirectoryWatch.WndProc(var aMsg: TMessage);
begin
  with aMsg do
    if Msg = NOTIFYCHANGE_MESSAGE then
    begin
      if assigned(OnChange) then OnChange(self);
    end else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
//------------------------------------------------------------------------------

procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters);
begin
  if aNotifyFilters = fNotifyFilters then exit;
  fNotifyFilters := aNotifyFilters;
  if assigned(fWatchThread) then
  begin
    Active := false;
    Active := true;
  end;
end;
//------------------------------------------------------------------------------

procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean);
begin
  if aWatchSubDirs = fWatchSubDirs then exit;
  fWatchSubDirs := aWatchSubDirs;
  if assigned(fWatchThread) then
  begin
    Active := false;
    Active := true;
  end;
end;
//------------------------------------------------------------------------------

procedure TDirectoryWatch.SetDirectory(aDir: string);
begin
  if aDir = '' then
  begin
    Active := false;
    fDirectory := '';
    exit;
  end;
  if (aDir[length(aDir)] <> '\') then aDir := aDir + '\';
  if aDir = fDirectory then exit;
  if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then
    raise Exception.Create( sInvalidDir + aDir);
  fDirectory := aDir;
  if assigned(fWatchThread) then
    fWatchThread.Directory := fDirectory;
end;
//------------------------------------------------------------------------------

procedure TDirectoryWatch.SetActive(aActive: boolean);
var
  nf: dword;
begin
  if aActive = fActive then exit;
  fActive := aActive;
  if csDesigning in ComponentState then exit;
  if fActive then
  begin
    if not DirectoryExists(fDirectory) then
    begin
      fActive := false;
      raise Exception.Create(sInvalidDir + fDirectory);
    end;
    nf := 0;
    if nfFilename in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME;
    if nfDirname in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
    if nfAttrib in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
    if nfSize in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_SIZE;
    if nfLastWrite in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
    if nfSecurity in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_SECURITY;
    fWatchThread := TWatchThread.Create(
      fWindowHandle, fDirectory, fWatchSubDirs, nf);
  end else
  begin
    fWatchThread.Terminate;
    fWatchThread := nil;
  end;
end;

//----------------------------------------------------------------------------
// TWatchThread methods ...
//----------------------------------------------------------------------------

constructor TWatchThread.Create(OwnerHdl: THandle;
  const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
begin
  inherited Create(True);       
  fOwnerHdl := OwnerHdl;
  if WatchSubDirs then
    cardinal(fWatchSubDirs) := 1 //workaround a Win9x OS issue
  else
    fWatchSubDirs := false;
  FreeOnTerminate := true;
  Priority := tpLowest;
  fDirectory := InitialDir;
  fNotifyFilters := NotifyFilters;
  fBreakEvent := windows.CreateEvent(nil, False, False, nil);
  Resume;
end;
//------------------------------------------------------------------------------

destructor TWatchThread.Destroy;
begin
  CloseHandle(fBreakEvent);
  inherited Destroy;
end;
//------------------------------------------------------------------------------

procedure TWatchThread.SetDirectory(const Value: string);
begin
  if (Value = FDirectory) then exit;
  FDirectory := Value;
  SetEvent(fBreakEvent);
end;
//------------------------------------------------------------------------------

procedure TWatchThread.Terminate;
begin
  inherited Terminate;
  SetEvent(fBreakEvent);
  while not fFinished do sleep(10); //avoids a reported resource leak
                                    //if called while closing the application.
end;
//------------------------------------------------------------------------------

procedure TWatchThread.Execute;
begin
  //OUTER LOOP - manages Directory property reassignments
  while (not Terminated) do
  begin
    fChangeNotify := FindFirstChangeNotification(pchar(fDirectory),
      fWatchSubDirs, fNotifyFilters);
    if (fChangeNotify = INVALID_HANDLE_VALUE) then
      //Can't monitor the specified directory so we'll just wait for
      //a new Directory assignment or the thread terminating ...
      WaitForSingleObject(fBreakEvent, INFINITE)
    else
      try
        //Now do the INNER loop...
        ProcessFilenameChanges;
      finally
        FindCloseChangeNotification(fChangeNotify);
      end;
  end;
  fFinished := true;
end;
//------------------------------------------------------------------------------

procedure TWatchThread.ProcessFilenameChanges;
var
  WaitResult : DWORD;
  HandleArray : array[0..1] of THandle;
const
  TEN_MSECS = 10;
  HUNDRED_MSECS = 100;
begin
  HandleArray[0] := fBreakEvent;
  HandleArray[1] := fChangeNotify;
  //INNER LOOP - exits only when fBreakEvent signaled
  while (not Terminated) do
  begin
    //waits for either fChangeNotify or fBreakEvent ...
    WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE);
    if (WaitResult = WAIT_OBJECT_0 + 1) then //fChangeNotify
    begin
      repeat //ie: if a number of files are changing in a block
             //just post the one notification message ...
        FindNextChangeNotification(fChangeNotify);
      until Terminated or
        (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0);
      if Terminated then break;
      //OK, now notify the main thread (before restarting inner loop)...
      PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0);
    end else //fBreakEvent ...
    begin
      //If the Directory property is undergoing multiple rapid reassignments
      //wait 'til this stops before restarting monitoring of a new directory ...
      while (not Terminated) and
        (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do;
      break; //EXIT LOOP HERE
    end;
  end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

end.