Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Компонент для отслеживания изменений в файловой системе
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.