Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Компонент для отслеживания изменений в файловой системе
{
Модуль слежения за изменениями в файловой системе.
Пример применения:
Создание:
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.
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.