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

FileWatch.pas

unit FileWatch;

interface

Uses
  Windows, SysUtils, Classes;

Const
  MAX_FAILS=12;
  FAIL_TIMEOUT=12;
  WPARAM_ERROR=-1;
  WPARAM_SUCCESS=1000;
  LPARAM_ERROR_FILENOTEXISTS=1;
  LPARAM_ERROR_OPENNOTIFICATION=2;
  LPARAM_ERROR_CONTINUENOTIFICATION=3;
  LPARAM_ERROR_DEADLOCK=4;
  LPARAM_ERROR_TEST=5;
  LPARAM_ERROR_CRITICAL=200;

Type
  TFileWatch=class(TThread)
  // сообщение fReportHandle для окна
  private
    fReportHandle,fReportMessage:cardinal;
    fChangeNotificationHandle:cardinal;
    fList:array of string;
    fFlags:cardinal;
    function GetCount:integer;
    function GetFiles(I:integer):string;
  protected
    procedure Execute;override;
  public
    property Count:integer read GetCount;
    property ReportHandle:cardinal read fReportHandle write fReportHandle;
    property Files[I:integer]:string read GetFiles;
    Constructor Create(aHandle,ReportMessage:cardinal;const aFiles:array of string;Flags:cardinal=FILE_NOTIFY_CHANGE_LAST_WRITE);
    Destructor Destroy;override;
  end;

function TryFileStream(const FileName:string;AccessRights:cardinal=fmOpenRead or fmShareDenyNone;
  MaxFails:cardinal=MAX_FAILS;FailDelay:cardinal=FAIL_TIMEOUT):TFileStream;

implementation

constructor TFileWatch.Create(aHandle, ReportMessage: cardinal;
  const aFiles: array of string;Flags:cardinal);
var
  I:integer;
begin
  SetLength(fList,Length(aFiles));
  For I:=Low(fList) to High(fList) do
    fList[I]:=ExpandFileName(aFiles[I]);
  fReportHandle:=aHandle;
  fReportMessage:=ReportMessage;
  fFlags:=Flags;
  inherited Create(false);
end;

destructor TFileWatch.Destroy;
begin
  Terminate;
  FindCloseChangeNotification(fChangeNotificationHandle);
  inherited;
end;

procedure TFileWatch.Execute;
var
  L:TStringList;
  Handles:array of cardinal;
  Times:array of FILETIME;
  Temp:FILETIME;
  I,J,FailCount,Cnt:integer;
  H:cardinal;
  Fail:boolean;
begin
  // cобираем время последнего изменения
  SetLength(Times,Length(fList));
  For I:=Low(Times) to High(Times) do begin
    H:=CreateFile(PChar(fList[I]),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
    if H=INVALID_HANDLE_VALUE then begin
      PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_FILENOTEXISTS);
      exit;
    end;
    GetFileTime(H,nil,nil,@Times[I]);
    CloseHandle(H);
  end;
  // собираем каталоги, за которыми надо следить
  L:=TStringList.Create;
  L.Duplicates:=dupIgnore;
  L.Sorted:=true;
  L.CaseSensitive:=false;
  For I:=Low(fList) to High(fList) do
    L.Add(ExtractFileDir(fList[I]));
  Cnt:=L.Count;
  if Cnt=0 then begin
    L.Free;
    PostMessage(fReportHandle,fReportMessage,0,-1);
    exit;
  end;
  // открываем слежение за всеми собранными каталогами
  SetLength(Handles,Cnt);
  For I:=0 to Cnt-1 do
    Handles[I]:=INVALID_HANDLE_VALUE;
  For I:=0 to Cnt-1 do
    Handles[I]:=FindFirstChangeNotification(PChar(L[I]),false,fFlags);
  // смотрим, не было ли при открытии каких-то проблем
  Fail:=false;
  For I:=0 to Cnt-1 do
    if Handles[I]=INVALID_HANDLE_VALUE then
      Fail:=true;
  // Если хотя бы за одним из каталогов не установлено слежение - прервать работу
  if Fail then begin
    For I:=0 to Cnt-1 do
      if Handles[I]<>INVALID_HANDLE_VALUE then
        FindCloseChangeNotification(Handles[I]);
    PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_OPENNOTIFICATION);
    L.Free;
    exit;
  end;
  // через этот хендл нас может пристрелить главное приложение
  fChangeNotificationHandle:=Handles[0];
  repeat
    I:=WaitForMultipleObjects(Cnt,@Handles[0],false,INFINITE);
    // произошло непонятно что. Встретился случайно, при отладке, в реальной работе не встречалось, но ХЗ.
    if I=-1 then begin
      Handles[0]:=INVALID_HANDLE_VALUE;
      PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_CRITICAL);
      break;
    end;
    // пристрелен главным приложением?
    if Terminated then begin
      Handles[0]:=INVALID_HANDLE_VALUE;
      break;
    end;
    // таймаута быть не может физически. Так что сразу продолжаем слежение за сработавшим хендлом
    if not FindNextChangeNotification(Handles[I-WAIT_OBJECT_0]) then begin
      PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_CONTINUENOTIFICATION);
      break;
    end;
    // противобаговая задержка. Почему-то некоторые программы отваливаются, когда создают файл
    // и при этом наш поток слежения пробует запросить дату создания.
    Sleep(FAIL_TIMEOUT);
    For J:=Low(fList) to High(fList) do begin
      if SameText(ExtractFileDir(fList[J]),L[I]) then begin
        // сработало на каком-то файле из этого каталога. Проверим дату изменения
        FailCount:=0;
        repeat
          // самое странное, что на этом этапе никогда не происходило ошибок!
          H:=CreateFile(PChar(fList[J]),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
          if H<>INVALID_HANDLE_VALUE then break;
          PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_TEST);
          Sleep(FAIL_TIMEOUT);
        until FailCount>MAX_FAILS;
        if H=INVALID_HANDLE_VALUE then
          PostMessage(fReportHandle,fReportMessage,WPARAM_ERROR,LPARAM_ERROR_DEADLOCK)
        else begin
          GetFileTime(H,nil,nil,@Temp);
          CloseHandle(H);
          if CompareFileTime({$IFDEF FPC}@{$ENDIF}Temp,{$IFDEF FPC}@{$ENDIF}Times[J])<>0 then begin
            Times[J]:=Temp;
            // переслать сообщение об изменении в основную программу
            PostMessage(fReportHandle,fReportMessage,WPARAM_SUCCESS,J);
          end;
        end;
      end;
    end;
  until false;
  // закрыть все нотификации
  For I:=0 to Cnt-1 do
    if Handles[I]<>INVALID_HANDLE_VALUE then
      FindCloseChangeNotification(Handles[I]);
  L.Free;
end;

function TFileWatch.GetCount: integer;
begin
  Result:=Length(fList);
end;

function TFileWatch.GetFiles(I: integer): string;
begin
  Result:=fList[I];
end;

function TryFileStream(const FileName:string;AccessRights:cardinal=fmOpenRead or fmShareDenyNone;
  MaxFails:cardinal=MAX_FAILS;FailDelay:cardinal=FAIL_TIMEOUT):TFileStream;
var
  Cnt:cardinal;
begin
  Cnt:=0;
  repeat
    try
      Result:=TFileStream.Create(FileName,AccessRights);
      exit;
    except
    end;
    Sleep(FailDelay);
    Inc(Cnt);
  until Cnt>=MaxFails;
  Result:=nil;
end;

end.