-
Couldn't load subscription status.
- Fork 35
Open
Description
Lazarus
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
DirectoryWatcherBuilder, DirectoryWatcherAPI;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
procedure OnFileEvent(const FilePath: String; const EventType: TDirectoryEventType);
public
end;
var
Form1: TForm1;
DirWatcher: IDirectoryWatcher;
FolderToWatch: String;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.OnFileEvent(const FilePath: String; const EventType: TDirectoryEventType);
var
EventTypeString: String;
begin
Memo1.Lines.Add('======NEW EVENT======');
Memo1.Lines.Add('File: ' + FilePath);
case EventType of
detAdded: EventTypeString := 'ADDED';
detRemoved: EventTypeString := 'REMOVED';
detModified: EventTypeString := 'MODIFIED';
end;
Memo1.Lines.Add('Type: ' + EventTypeString);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FolderToWatch := ExtractFileDir(ParamStr(0));
DirWatcher := TDirectoryWatcherBuilder.New.WatchDirectory(FolderToWatch).Recursively(True).Build;
DirWatcher.Start;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DirWatcher := nil;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Memo1.Lines.SaveToFile(ExtractFileDir(ParamStr(0)) + '\fl.txt');
end;
end.
unit DirectoryWatcherThread.Windows
procedure TDirectoryWatcherThreadWindows.Execute;
var
pBuffer : Pointer;
dwBufLen : DWORD;
dwRead : DWORD;
PInfo : PFileNotifyInformation;
dwNextOfs : DWORD;
dwFnLen : DWORD;
Overlap : TOverlapped;
WaitResult: DWORD;
EventArray : Array[0..2] of THandle;
FileName : String;
HandleAsString: String;
FilePath: String;
begin
FEventTriggerThread.Start;
FhFile := CreateFile(PChar(FDirectory),
FILE_LIST_DIRECTORY or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
Nil,
OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,
0);
if (FhFile = INVALID_HANDLE_VALUE) or (FhFile = 0) then
Exit;
FileEvent := CreateEvent(Nil, False, False, Nil);
Overlap.hEvent := FileEvent;
HandleAsString := IntToStr(Handle);
TermEvent := TEvent.Create(Nil, False, False, HandleAsString + 'N');
SuspEvent := TEvent.Create(Nil, False, False, HandleAsString + 'W');
EventArray[0] := FileEvent;
EventArray[1] := Integer(TermEvent.Handle^);
EventArray[2] := Integer(SuspEvent.Handle^);
dwBufLen := 65535;
pBuffer := AllocMem(dwBufLen);
try
while not Terminated do
begin
dwRead:=0;
if ReadDirectoryChangesW(FhFile, pBuffer, dwBufLen, FWatchSubtree,
FFilter, @dwRead, @Overlap, Nil) then
begin
WaitResult := WaitForMultipleObjects(Length(EventArray), @EventArray, False, INFINITE);
case WaitResult of
WaitDir:
begin
PInfo := pBuffer;
repeat
dwNextOfs := PInfo.dwNextEntryOffset;
fAction := PInfo.dwAction;
dwFnLen := PInfo.dwFileNameLength;
FileName := String(WideCharLenToString(@PInfo.dwFileName, dwFnLen div 2));
FilePath := FDirectory + FileName;
if not DirectoryExists(FilePath) then
FEventTriggerThread.EnqueueEvent(FilePath, ActionIDToEventType(FAction));
PChar(PInfo) := PChar(PInfo) + dwNextOfs;
until dwNextOfs = 0;
end;
WaitTerm: Terminate;
WaitSusp: Terminate;
else
Break;
end;
end;
end;
finally
FreeMem(pBuffer, dwBufLen);
end;
end;
External: SIGSEGV exception on WaitResult := WaitForMultipleObjects(Length(EventArray), @EventArray, False, INFINITE);
Metadata
Metadata
Assignees
Labels
No labels