{------------------------------------------------------------------------------}
{
   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     :
}
{------------------------------------------------------------------------------}
{ $define LogDirWatchErrors}

unit DirWatch;

interface

uses
    Windows,Messages,Classes,syncobjs,sysutils,controls
{$ifdef LogDirWatchErrors}
    ,ErrorHeader
{$endif}
    ;

const WM_DIRCHANGE = WM_USER+100;

type

  TDirWatch=class;

  TDirWatchEvent = procedure (sender:TDirWatch) of object;
  TFileWatchInfo = TWin32FindData;

  TDirWatch=class(TWinControl)
  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
    WHandle : THandle;
    DoWatch:boolean;
    procedure UpdateWatch;  virtual;
    function GetAsString: string; virtual;
  public
    constructor Create(AOwner:TComponent); override;
    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 : TFileWatchInfo;
    procedure SetFileName(const Value: string);
  protected
    procedure UpdateWatch;  override;
    function GetAsString: string; override;
  public
    procedure Notify; override;
  published
    property FileName : string read FFileName write SetFileName;
    property FileInfo : TFileWatchInfo read FInfo;
  end;



{$ifdef LogDirWatchErrors}
var
  AddError : TPAddCError;
  CommDebug : Pointer;
{$endif}

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;

{$ifdef LogDirWatchErrors}
procedure DoAddError(const s:string);
begin
  if ( @AddError = nil ) then exit;
  AddError(CommDebug,PChar(s));
end;
{$endif}


procedure cDirWatch.Execute;
var
  Handles: TWOHandleArray;
  DirWatches: array [0..MAXIMUM_WAIT_OBJECTS - 1] of TDirWatch;
  cHandles,cControlHandles,WaitRes,i: DWORD;
  DWItem:TDirWatch;
begin
     // WHandle to UpdateWatch 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.WHandle=INVALID_HANDLE_VALUE) then begin
             DWItem.WHandle:=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.WHandle<>INVALID_HANDLE_VALUE) then begin
              Handles[cHandles]:=DWItem.WHandle;
              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;
            if ( DWItem.DoWatch ) then
              PostMessage(DWItem.Handle,WM_DIRCHANGE,0,0);
            FindNextChangeNotification(DWItem.WHandle);
          end;
       end until WaitRes=WAIT_OBJECT_0; // Exit when UpdateWatch event has been sent

       // On UpdateWatch close necessary handles
       for i:=cControlHandles to cHandles-1 do begin
         DWItem:=DirWatches[i];
         if (DWItem<>nil) and (DWItem.WHandle<>INVALID_HANDLE_VALUE) and not DWItem.DoWatch then begin
           FindCloseChangeNotification(DWItem.WHandle);
           DWItem.WHandle:=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(AOwner:TComponent);
begin
     inherited;
     Lock.Enter;
     Filter:=(FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_LAST_WRITE);
     Recursive:=false;
     WHandle:=INVALID_HANDLE_VALUE;
     DoWatch:=false;
     if (DirWatchList=nil) then DirWatchList:=TList.Create;
     DirWatchList.Add(self);
     If AOwner is TWinControl then Parent := TWinControl(AOwner);
     HandleNeeded;
     Lock.Leave;
end;

procedure TDirWatch.Watch(const dir:String);
begin
  self.Dir:=dir;
  Watch;
end;

procedure TDirWatch.Stop;
begin
     Lock.Enter;
     DoWatch:=false;
     UpdateWatch;
     Lock.Leave;
end;

procedure TDirWatch.Watch;
begin
     Lock.Enter;
     DoWatch:=true;
     UpdateWatch;
     Lock.Leave;
end;

procedure TDirWatch.UpdateWatch();
begin
     Lock.Enter;
     if (DoWatch) or (WHandle<>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;
//     Parent := nil;
     // We do not need to notify thread if the WHandle does not exist
     if (WHandle<>INVALID_HANDLE_VALUE) then begin
       DoWatch:=false;
       evUpdateDone.ResetEvent;
       UpdateWatch;
       Lock.Leave;

       i:=0;
       repeat
         evUpdateDone.WaitFor(1000);
         i:=i+1;
       until (WHandle=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;
     inherited;
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;

{$ifdef LogDirWatchErrors}
procedure AddE(const st:string;const info:TFileWatchInfo);
var s,a:WORD; t : TSystemTime;
begin
  FileTimeToSystemTime(info.ftLastWriteTime,t);
  s := info.nFileSizeLow;
  a := info.dwFileAttributes;
  DoAddError(st+IntToStr(t.wMinute) + ':'+IntToStr(t.wSecond) + '.' + IntToStr(t.wMilliseconds) + ' ' + IntToStr(s) + ' ' + IntToStr(a));
end;
{$endif}


procedure GetFileInfo(const st,name:string;var info:TFileWatchInfo);
begin
  if not ( GetFileAttributesEx(PChar(name),GetFileExInfoStandard,@info) ) then begin
    info.ftLastWriteTime.dwLowDateTime   := 0;
    info.ftLastWriteTime.dwHighDateTime  := 0;
    info.nFileSizeLow                    := 0;
    info.nFileSizeHigh                   := 0;
    info.dwFileAttributes                := 0;
  end;
{$ifdef LogDirWatchErrors}
  AddE(st,info);
{$endif}
end;

function CompareInfo(const i1,i2:TFileWatchInfo):boolean;
begin
  Result := false;
  if ( i1.ftLastWriteTime.dwLowDateTime <> i2.ftLastWriteTime.dwLowDateTime ) then exit;
  if ( i1.ftLastWriteTime.dwHighDateTime <> i2.ftLastWriteTime.dwHighDateTime ) then exit;
  if ( i1.nFileSizeLow     <> i2.nFileSizeLow )  then exit;
  if ( i1.nFileSizeHigh    <> i2.nFileSizeHigh ) then exit;
  if ( i1.dwFileAttributes <> i2.dwFileAttributes ) then exit;
  Result := true;
end;

procedure TFileWatch.Notify;
var info : TWin32FindData;
begin
  GetFileInfo('N:',AsString,info);
  if CompareInfo(info,FileInfo) then exit;

  if ( Assigned(OnChange) ) then OnChange(self);
  FInfo := info;
end;

procedure TFileWatch.SetFileName(const Value: string);
begin
  FFileName := Value;
end;


procedure TFileWatch.UpdateWatch;
begin
  if ( DoWatch ) then begin
    GetFileInfo('U:',AsString,FInfo);
  end;
  inherited;
end;


procedure TDirWatch.WMDirChange(var Message: TMessage);
begin
  if ( DoWatch ) then
    Notify;
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.