Компонент для отслеживания изменений в файловой системе

DirectoryWatch.pas

{
Модуль слежения за изменениями в файловой системе.
Пример применения:
Создание:
var
  Waiter:TDirectoryWatch;
  ...
  Waiter:=TDirectoryWatch.Create;
  // подключение объектных, или простых обработчиков
  Waiter.OnObjectAdd:=GetAdd;
  Waiter.OnObjectModify:=GetModify;
  // указание каталога для обработки
  Waiter.Folder:='E:\exe';
  // следует ли отслеживать подкаталоги
  Waiter.Subtree:=false;
  // по окончанию настройки, включить слежение
  Waiter.Active:=true;
Обработка:
  procedure TForm1.GetAdd(const FileName: string);
  begin
    Memo1.Lines.Add('Добавлен файл: '+FileName);
  end;
  procedure TForm1.GetModify(const FileName: string);
  begin
    Memo1.Lines.Add('Изменился файл: '+FileName);
  end;
Удаление:
  Waiter.Free;

Модуль использует ReadDirectoryChangesW, а не FindFirstChangeNotification,
так как в FFCN при срабатывании триггера файл всё ещё заблокирован и нужно
предусматривать какую-то отвязку, например, другим потоком, что затрудняет
реализацию.
}
unit DirectoryWatch;

interface

uses
  Windows, Messages, SysUtils;

Const
  FNI_SIZE=64*1024;

type
  {$IFNDEF FPC}
  UnicodeString=WideString;
  {$ENDIF}

  TOnFileOperation=procedure(const FileName:string);
  TOnFileModify=procedure(const OldFileName,FileName:string);
  TOnAlert=procedure(Code:integer);
  TOnObjectFileOperation=procedure(const FileName:string) of object;
  TOnObjectFileModify=procedure(const OldFileName,FileName:string) of object;
  TNotifyObjectAlert=procedure(Code:integer)of object;

  PFileNotifyInformation=^TFileNotifyInformation;
  TFileNotifyInformation=packed record
    NextEntryOffset:cardinal;
    Action:cardinal;
    FileNameLength:cardinal;
    FileName:array[0..1]of widechar;
  end;

  TDirectoryWatch=class
  private
    fRestartEvent,fRunEvent:cardinal;
    fTerminated:boolean;
    FDuplicate:boolean;
    fThreadId,fThreadHandle:cardinal;

    FFolder:string;
    FSubtree:boolean;

    FOnAdd,FOnDelete,FOnModify:TOnFileOperation;
    FOnRename:TOnFileModify;
    fOnAlert:TOnAlert;
    fOnObjectAdd,fOnObjectDelete,fOnObjectModify:TOnObjectFileOperation;
    fOnObjectRename:TOnObjectFileModify;
    fOnObjectAlert:TNotifyObjectAlert;
    procedure SetNotify(Index:integer;Value:TOnFileOperation);
    procedure SetNotify2(Index:integer;Value:TOnFileModify);
    procedure SetObjectNotify(Index:integer;Value:TOnObjectFileOperation);
    procedure SetObjectNotify2(Index:integer;Value:TOnObjectFileModify);
    procedure SetSubtree(Value:boolean);
    procedure SetFolder(const Value:string);
    function GetActive:boolean;
    procedure SetActive(Value:boolean);
  public
    property Folder:string read FFolder write SetFolder;
    property Active:boolean read GetActive write SetActive;
    property OnAlert:TOnAlert read fOnAlert write fOnAlert;
    property OnObjectAlert:TNotifyObjectAlert read fOnObjectAlert write fOnObjectAlert;
    property OnAdd:TOnFileOperation index 0 read FOnAdd write SetNotify;
    property OnDelete:TOnFileOperation index 1 read FOnDelete write SetNotify;
    property OnModify:TOnFileOperation index 2 read FOnModify write SetNotify;
    property OnRename:TOnFileModify index 0 read FOnRename write SetNotify2;
    property OnObjectAdd:TOnObjectFileOperation index 0 read FOnObjectAdd write SetObjectNotify;
    property OnObjectDelete:TOnObjectFileOperation index 1 read FOnObjectDelete write SetObjectNotify;
    property OnObjectModify:TOnObjectFileOperation index 2 read FOnObjectModify write SetObjectNotify;
    property OnObjectRename:TOnObjectFileModify index 0 read FOnObjectRename write SetObjectNotify2;
    property Subtree:boolean read FSubtree write SetSubtree;
    Constructor Create;
    Destructor Destroy;override;
  end;

implementation

procedure OnComplete(Error,Transferred:cardinal;var Over:TOverlapped);stdcall;
var
  Owner:TDirectoryWatch;
  S,Old:UnicodeString;
  I:integer;
  MyFni:PFileNotifyInformation;
begin
  Owner:=TDirectoryWatch(Over.Offset);
  MyFni:=PFileNotifyInformation(Over.OffsetHigh);
  Old:='';
  repeat
    SetLength(S,MyFni.FileNameLength div 2);
    For I:=1 to Length(S) do
      S[I]:=MyFni.FileName[I-1];
    case MyFni.Action of
      FILE_ACTION_ADDED:begin
        if Assigned(Owner.OnObjectAdd) then
          Owner.OnObjectAdd(S);
        if Assigned(Owner.OnAdd) then
          Owner.OnAdd(S);
      end;
      FILE_ACTION_REMOVED:begin
        if Assigned(Owner.OnObjectDelete) then
          Owner.OnObjectDelete(S);
        if Assigned(Owner.OnDelete) then
          Owner.OnDelete(S);
      end;
      FILE_ACTION_MODIFIED:begin
        if Owner.FDuplicate then begin
          if Assigned(Owner.OnObjectModify) then
            Owner.OnObjectModify(S);
          if Assigned(Owner.OnModify) then
            Owner.OnModify(S);
        end;
        Owner.FDuplicate:=not Owner.FDuplicate;
      end;
      FILE_ACTION_RENAMED_OLD_NAME:Old:=S;
      FILE_ACTION_RENAMED_NEW_NAME:begin
        if Assigned(Owner.OnObjectRename) then
          Owner.OnObjectRename(Old,S);
        if Assigned(Owner.OnRename) then
          Owner.OnRename(Old,S);
      end;
    end;
    if MyFni.NextEntryOffset=0 then
      break;
    Inc(cardinal(MyFni),MyFni.NextEntryOffset);
  until false;
end;

function ThreadProc(P:pointer):integer;
const
  FILE_LIST_DIRECTORY=1;
var
  hDir:cardinal;
  Over:TOverlapped;
  R:cardinal;
  ControlFlag:cardinal;
  Fni:PFileNotifyInformation;
  Self:TDirectoryWatch absolute P;
begin
  ZeroMemory(@Over,sizeof(TOverlapped));
  GetMem(Fni,FNI_SIZE);
  Over.hEvent:=CreateEvent(nil,false,false,nil);
  Over.Offset:=cardinal(Self);
  Over.OffsetHigh:=cardinal(Fni);
  Result:=0;
  repeat
    WaitForSingleObject(Self.fRunEvent,INFINITE);
    if Self.fTerminated then
      break;
    hDir:=CreateFile(PChar(Self.FFolder),FILE_LIST_DIRECTORY,FILE_SHARE_DELETE or FILE_SHARE_READ or FILE_SHARE_WRITE,
      nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,0);
    if(Assigned(Self.OnAdd) or Assigned(Self.OnDelete) or Assigned(Self.OnRename) or
      Assigned(Self.OnModify) or Assigned(Self.OnObjectAdd) or Assigned(Self.OnObjectDelete) or
      Assigned(Self.OnObjectModify) or Assigned(Self.fOnObjectRename))and(Self.FFolder<>'')then begin
      ControlFlag:=0;
      if Assigned(Self.OnModify) or Assigned(Self.OnObjectModify) then
        ControlFlag:=FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE;
      repeat
        if(not ReadDirectoryChanges(hDir,Fni,FNI_SIZE,true,
          ControlFlag or FILE_NOTIFY_CHANGE_FILE_NAME,nil,@Over,@OnComplete))then begin
          Result:=1;
          Self.fTerminated:=true;
        end;
        R:=WaitForSingleObjectEx(Self.fRestartEvent,INFINITE,true);
        if R=cardinal(-1) then begin
          Result:=2;
          Self.fTerminated:=true;
        end;
      until R=WAIT_OBJECT_0; // зацикливаемся, пока не установится событие
      CancelIo(hDir);
    end else WaitForSingleObjectEx(Self.fRestartEvent,INFINITE,true);
    CloseHandle(hDir);
  until Self.fTerminated;
  CloseHandle(Over.hEvent);
  FreeMem(Fni);
end;

{ TDirectoryWatch }

constructor TDirectoryWatch.Create;
begin
  fRestartEvent:=CreateEvent(nil,false,false,nil);
  fRunEvent:=CreateEvent(nil,true,false,nil);
  fThreadHandle:=BeginThread(nil,64*1024,@ThreadProc,Self,0,fThreadId);
  if fThreadHandle=0 then
    RaiseLastOSError;
  inherited Create;
end;

destructor TDirectoryWatch.Destroy;
begin
  fTerminated:=true;
  SetEvent(fRunEvent);
  SetEvent(fRestartEvent);
  if WaitForSingleObject(fThreadHandle,1000)=WAIT_TIMEOUT then
    TerminateThread(fThreadHandle,1);
  CloseHandle(fRestartEvent);
  CloseHandle(fRunEvent);
  CloseHandle(fThreadHandle);
  inherited;
end;

procedure TDirectoryWatch.SetActive(Value: boolean);
begin
  if Value then begin
    ResetEvent(fRestartEvent);
    SetEvent(fRunEvent);
  end else begin
    ResetEvent(fRunEvent);
    SetEvent(fRestartEvent);
  end;
end;

procedure TDirectoryWatch.SetNotify(Index: integer; Value: TOnFileOperation);
begin
  case Index of
    0:begin
      if @FOnAdd=@Value then
        exit;
      FOnAdd:=Value;
    end;
    1:begin
      if @FOnDelete=@Value then
        exit;
      FOnDelete:=Value;
    end;
    2:begin
      if @FOnModify=@Value then
        exit;
      FOnModify:=Value;
    end;
    else exit;
  end;
  SetEvent(fRestartEvent);
end;

procedure TDirectoryWatch.SetNotify2(Index: integer; Value: TOnFileModify);
begin
  case Index of
    0:begin
      if @FOnRename=@Value then
        exit;
      FOnRename:=Value;
    end;
    else exit;
  end;
  SetEvent(fRestartEvent);
end;

procedure TDirectoryWatch.SetObjectNotify(Index: integer; Value: TOnObjectFileOperation);
begin
  case Index of
    0:begin
      if @FOnObjectAdd=@Value then
        exit;
      FOnObjectAdd:=Value;
    end;
    1:begin
      if @FOnObjectDelete=@Value then
        exit;
      FOnObjectDelete:=Value;
    end;
    2:begin
      if @FOnObjectModify=@Value then
        exit;
      FOnObjectModify:=Value;
    end;
    else exit;
  end;
  SetEvent(fRestartEvent);
end;

procedure TDirectoryWatch.SetObjectNotify2(Index: integer; Value: TOnObjectFileModify);
begin
  case Index of
    0:begin
      if @FOnObjectRename=@Value then
        exit;
      FOnObjectRename:=Value;
    end;
    else exit;
  end;
  SetEvent(fRestartEvent);
end;

procedure TDirectoryWatch.SetFolder(const Value: string);
begin
  if DirectoryExists(Value) then
    FFolder:=Value
  else
    FFolder:='';
  SetEvent(fRestartEvent);
end;

procedure TDirectoryWatch.SetSubtree(Value: boolean);
begin
  FSubTree:=Value;
  SetEvent(fRestartEvent);
end;

function TDirectoryWatch.GetActive: boolean;
begin
  Result:=WaitForSingleObject(fRunEvent,0)=WAIT_OBJECT_0;
end;

end.