{------------------------------------------------------------------------------}
{
   Unit Name: DirWatch
   Purpose  : Component to watch changes on selected directories
   Author   : Timo Lappalainen
   Date     : ??.??.98
   Changed  : 07.08.2000/Vesa Lappalainen
     - TDirWatchEvent and OnChange
     - TFileWatch

   ToDo     :
} 
{------------------------------------------------------------------------------}

unit DirWatch;

interface
uses
    Windows,Messages,Classes,syncobjs,sysutils;

const WM_DIRCHANGE = WM_USER+100;

type

  TDirWatch=class;

  TDirWatchEvent = procedure (sender:TDirWatch) of object;

  TDirWatch=class
  private
    FDir: string;
    FFilter: DWORD;
    FRecursive: BOOL;
    FOnChange : TDirWatchEvent;
    procedure SetDir(const Value: string);
    procedure SetFilter(const Value: DWORD);
    procedure SetRecursive(const Value: BOOL);
  protected
    DoWatch:boolean;
    Handle:THandle;
    procedure Update;  virtual;
    function GetAsString: string; virtual;
  public
    constructor Create;
    procedure Notify; virtual;
    procedure Notify; virtual;
    procedure Watch(const dir:String);  overload; virtual;
    procedure Stop;  virtual;
    procedure Watch;  overload; virtual;
    destructor Destroy; override;
    procedure WMDirChange(var Message: TMessage); message WM_DIRCHANGE;
  published
    property Dir:string read FDir write SetDir;
    property Filter:DWORD read FFilter write SetFilter;
    property Recursive:BOOL read FRecursive write SetRecursive;
    property OnChange : TDirWatchEvent read FOnChange write FOnChange;
    property AsString : string read GetAsString;
  end;

  TFileWatch = class(TDirWatch)
  private
    FFileName: string;
    FInfo : TSearchRec;
    procedure SetFileName(const Value: string);
  protected
    procedure Update;  override;
    function GetAsString: string; override;
  public
    procedure Notify; override;
    procedure Watch;  override;
  published
    property FileName : string read FFileName write SetFileName;
    property Info : TSearchRec read FInfo;
  end;


implementation

//============================================================================
// cDirWatch - a thread for TDirWatch
//============================================================================

type

    cDirWatch=class(TThread)

    protected
      procedure Execute; override;

    public
      constructor Create;
      procedure Stop;

    end;

var
  DirWatchList:TList;
  Lock:TCriticalSection;
  evUpdate,evUpdateDone:TEvent;
  DirWatchThread:cDirWatch;

procedure cDirWatch.Execute;
var
  Handles: TWOHandleArray;
  DirWatches: array [0..MAXIMUM_WAIT_OBJECTS - 1] of TDirWatch;
  cHandles,cControlHandles,WaitRes,i: DWORD;
  DWItem:TDirWatch;
begin
     // Handle to update event is allways at pos 0
     Handles[0]:=evUpdate.Handle;
     cControlHandles:=1;

     Lock.Enter;
     while not Terminated do begin
       cHandles:=cControlHandles;
       // Create handles to directory watch
       // Collect from list all watches which should be under watch
       for i:=0 to DirWatchList.Count-1 do begin
         DWItem:=DirWatchList.Items[i];
         if (DWItem<>nil) and DWItem.DoWatch then begin
           if (DWItem.Handle=INVALID_HANDLE_VALUE) then begin
             DWItem.Handle:=FindFirstChangeNotification(PChar(DWItem.Dir),DWItem.Recursive,DWItem.Filter);
           end;

           // Add all good handles to Handles array and pointer to class
           // to same index position to DirWatches
           if (DWItem.Handle<>INVALID_HANDLE_VALUE) then begin
              Handles[cHandles]:=DWItem.Handle;
              DirWatches[cHandles]:=DWItem;
              cHandles:=cHandles+1;
           end;
         end; // if valid watch
       end;

       repeat begin
          // Wait any event tobe signaled
          evUpdateDone.SetEvent;
          Lock.Leave;
          WaitRes:=WaitForMultipleObjects(cHandles,  @Handles,false,INFINITE);

          Lock.Enter;
          // Check that exited by directory change
          if (WAIT_OBJECT_0+cControlHandles <= WaitRes) and (WaitRes < WAIT_OBJECT_0+cHandles) then begin
            // Sent the specified message to specified window
            DWItem:=DirWatches[WaitRes-WAIT_OBJECT_0-cControlHandles+1];
            DWItem.Notify;
            FindNextChangeNotification(DWItem.Handle);
          end;
       end until WaitRes=WAIT_OBJECT_0; // Exit when update event has been sent

       // On update close necessary handles
       for i:=cControlHandles to cHandles-1 do begin
         DWItem:=DirWatches[i];
         if (DWItem<>nil) and (DWItem.Handle<>INVALID_HANDLE_VALUE) and not DWItem.DoWatch then begin
           FindCloseChangeNotification(DWItem.Handle);
           DWItem.Handle:=INVALID_HANDLE_VALUE;
         end;
       end;

     end; // while not terminated

    Lock.Leave;
    evUpdateDone.SetEvent;
end;

constructor cDirWatch.Create();
begin
     Lock.Enter;
     inherited Create(False);
     evUpdate:=TEvent.Create(nil,false,false,'evDirWatchUpdate'+IntToStr(Handle));
     evUpdateDone:=TEvent.Create(nil,true,false,'evDirWatchUpdateDone'+IntToStr(Handle));
     FreeOnTerminate:=True;
     Lock.Leave;
end;

procedure cDirWatch.Stop;
begin
     Lock.Enter;
     Terminate;
     evUpdate.SetEvent;
     Lock.Leave;
end;

//============================================================================
// TDirWatch
//============================================================================

constructor TDirWatch.Create();
begin
     Lock.Enter;
     Filter:=(FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE);
     Recursive:=false;
     Handle:=INVALID_HANDLE_VALUE;
     DoWatch:=false;
     if (DirWatchList=nil) then DirWatchList:=TList.Create;
     DirWatchList.Add(self);
     Lock.Leave;
end;

procedure TDirWatch.Watch(const dir:String);
begin
  self.Dir:=dir;
  Watch;
end;

procedure TDirWatch.Stop;
begin
     Lock.Enter;
     DoWatch:=false;
     Update;
     Lock.Leave;
end;

procedure TDirWatch.Watch;
begin
     Lock.Enter;
     DoWatch:=true;
     Update;
     Lock.Leave;
end;

procedure TDirWatch.Update();
begin
     Lock.Enter;
     if (DoWatch) or (Handle<>INVALID_HANDLE_VALUE) then begin
       if (evUpdate<>nil) then evUpdate.SetEvent
       else DirWatchThread:=cDirWatch.Create;
     end;
     Lock.Leave;
end;

procedure TDirWatch.Notify();
begin
  if ( Assigned(OnChange) ) then OnChange(self);
end;

destructor TDirWatch.Destroy;
var
  i:integer;
begin
     Lock.Enter;
     // We do not need to notify thread if the handle does not exist
     if (Handle<>INVALID_HANDLE_VALUE) then begin
       DoWatch:=false;
       evUpdateDone.ResetEvent;
       Update;
       Lock.Leave;

       i:=0;
       repeat
         evUpdateDone.WaitFor(1000);
         i:=i+1;
       until (Handle=INVALID_HANDLE_VALUE) or (i=10);

       Lock.Enter;
     end;

     // Remove this object from list.
     i := DirWatchList.IndexOf(self);
     if i >=0 then DirWatchList.Delete(i);
     Lock.Leave;
end;

procedure TDirWatch.SetDir(const Value: string);
begin
  FDir := Value;
end;

procedure TDirWatch.SetFilter(const Value: DWORD);
begin
  FFilter := Value;
end;

procedure TDirWatch.SetRecursive(const Value: BOOL);
begin
  FRecursive := Value;
end;

function TDirWatch.GetAsString: string;
begin
  Result := Dir;
end;

//============================================================================
{ TFileWatch }

function TFileWatch.GetAsString: string;
begin
  Result := Dir + '\' + FileName;
end;

procedure TFileWatch.Notify;
var info : TSearchRec;
begin
  FindFirst(AsString,0,info);
  if ( info.Time = FInfo.Time ) and
     ( info.Size = FInfo.Size ) and
     ( info.Attr = FInfo.Attr ) 
    then exit;
  if ( Assigned(OnChange) ) then OnChange(self);
  FInfo := info;
end;

procedure TFileWatch.SetFileName(const Value: string);
begin
  FFileName := Value;
end;


procedure TFileWatch.Update;
begin
  FindFirst(AsString,0,FInfo);
  inherited;
end;

procedure TFileWatch.Watch;
begin
  inherited;
end;

initialization begin
  evUpdate:=nil;
  DirWatchList:=nil;
  Lock:=TCriticalSection.Create;
end;

finalization begin
  if DirWatchThread<>nil then begin
    DirWatchThread.Stop;
    WaitForSingleObject(DirWatchThread.Handle,2000);
  end;
  if DirWatchList <> nil then DirWatchList.Free;
  Lock.Free;
  if evUpdate<>nil then evUpdate.Free;
  if evUpdateDone<>nil then evUpdateDone.Free;
end;

end.
