See the code in attachment
I changed the code a little bit adding the OVERLAP parameter and events
to use the async method.
Now the same function returns error code 6
Antonio.
procedure TFrmMain.StartNotify(const FolderName: String);
{$IFDEF LINUX}
function decodeMask(Mask:Longint):string;
var
Rslt:String;
begin
Rslt:='';
if (Mask and IN_ACCESS)=IN_ACCESS then
Rslt:=Rslt+' File was accessed.';
if (Mask and IN_MODIFY)=IN_MODIFY then
Rslt:=Rslt+' File was modified.';
if (Mask and IN_ATTRIB)=IN_ATTRIB then
Rslt:=Rslt+' Attribute was changed.';
if (Mask and IN_CLOSE_WRITE)=IN_CLOSE_WRITE then
Rslt:=Rslt+' Writtable file was closed.';
if (Mask and IN_CLOSE_NOWRITE)=IN_CLOSE_NOWRITE then
Rslt:=Rslt+' Unwrittable file was closed.';
if (Mask and IN_CLOSE)=IN_CLOSE then
Rslt:=Rslt+' File was closed.';
if (Mask and IN_OPEN)=IN_OPEN then
Rslt:=Rslt+' File was opened.';
if (Mask and IN_MOVED_FROM)=IN_MOVED_FROM then
Rslt:=Rslt+' File was moved from ';
if (Mask and IN_MOVED_TO)=IN_MOVED_TO then
Rslt:=Rslt+' File was moved to ';
if (Mask and IN_MOVE)=IN_MOVE then
Rslt:=Rslt+' File is moving';
if (Mask and IN_CREATE)=IN_CREATE then
Rslt:=Rslt+' Subfile was created';
if (Mask and IN_DELETE)=IN_DELETE then
Rslt:=Rslt+' Subfile was deleted';
if (Mask and IN_DELETE_SELF)=IN_DELETE_SELF then
Rslt:=Rslt+' Self was deleted';
if (Mask and IN_MOVE_SELF)=IN_MOVE_SELF then
Rslt:=Rslt+' Self was moved';
if (Mask and IN_UNMOUNT)=IN_UNMOUNT then
Rslt:=Rslt+' Filesystem was unmounted';
if (Mask and IN_Q_OVERFLOW)=IN_Q_OVERFLOW then
Rslt:=Rslt+' Event queued overflowed';
if (Mask and IN_IGNORED)=IN_IGNORED then
Rslt:=Rslt+' File was ignored';
if (Mask and IN_ONLYDIR)=IN_ONLYDIR then
Rslt:=Rslt+' Only watch the path if it is a directory';
if (Mask and IN_DONT_FOLLOW)=IN_DONT_FOLLOW then
Rslt:=Rslt+' Do not follow a sym link';
if (Mask and IN_MASK_ADD)=IN_MASK_ADD then
Rslt:=Rslt+' Add to the mast of an already existing watch';
if (Mask and IN_ISDIR)=IN_ISDIR then
Rslt:=Rslt+' Event occurred against dir';
if (Mask and IN_ONESHOT)=IN_ONESHOT then
Rslt:=Rslt+' Only send event once';
decodeMask:=Rslt;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
function decodeMask(Mask:Longint):string;
var
Rslt:String;
begin
Result := '';
if (Mask and FILE_ACTION_ADDED) = FILE_ACTION_ADDED then
Result := Result + ' file ADDED';
if (Mask and FILE_ACTION_REMOVED) = FILE_ACTION_REMOVED then
Result := Result + ' file REMOVED';
if (Mask and FILE_ACTION_MODIFIED) = FILE_ACTION_MODIFIED then
Result := Result + ' file CHANGED';
end;
{$ENDIF}
var
wFolderName: String;
FileName: String;
Timeout: Integer=200;
Buffer: PChar;
PData: Pointer;
P: Integer;
{$IFDEF LINUX}
Ret: Integer;
instance_handle: cint;
notify_handle: cint;
rfds: tfdset;
length: Integer;
iEvent: inotify_event;
buflen: Integer=(SizeOf(iEvent) + 16) * 512;
evnt: Pinotify_event;
TotalRead: TSsize;
FileName: String;
{$ENDIF}
{$IFDEF MSWINDOWS}
wHandle: THANDLE;
Ret: Integer;
Res: BOOL;
pFileInfo: PFILE_NOTIFY_INFORMATION;
buflen: DWORD=SizeOf(FILE_NOTIFY_INFORMATION) * 512;
TotalRead: DWORD;
Error: Integer;
Overlap: OVERLAPPED;
events: array[0..1] of THANDLE;
Ev1: TEvent;
Ev2: TEvent;
{$ENDIF}
begin
wFolderName := ExcludeTrailingPathDelimiter(Trim(FolderName));
{$IFDEF MSWINDOWS}
wHandle := FindFirstChangeNotificationA(PChar(wFolderName),
DWORD(LongBool(False)), FILE_NOTIFY_CHANGE_SIZE +
FILE_NOTIFY_CHANGE_LAST_WRITE);
try
if wHandle = INVALID_HANDLE_VALUE then begin
MessageDlg('Error','Invalid notify handle', mtError, [mbOK], 0, mbOK);
Exit
end;
Ev1 := TEvent.Create(nil, False, False, 'FEV1_tralala');
Ev2 := TEvent.Create(nil, False, False, 'FEV2_tralala');
events[0] := THANDLE(Ev1.Handle);
events[1] := THANDLE(Ev2.Handle);
FillMemory(@Overlap, SizeOf(OVERLAPPED), byte(#0));
Overlap.hEvent := THANDLE(Ev1.Handle);
FStopNotify := False;
PData := nil;
buflen := 32 * 1024;
ReAllocMem(PData, buflen);
//Buffer := system.Align(PData, 16);
Buffer := PData;
while not FStopNotify do begin
Ret := WaitForSingleObject(wHandle, 200);
if Ret = WAIT_OBJECT_0 then begin
FillMemory(PData, buflen, byte(#0));
Res := ReadDirectoryChangesW(wHandle, Buffer, buflen, False,
FILE_NOTIFY_CHANGE_FILE_NAME + FILE_NOTIFY_CHANGE_SIZE +
FILE_NOTIFY_CHANGE_LAST_WRITE, @TotalRead, @Overlap, nil);
if not Res then begin
Error := GetLastError;
FStopNotify := True;
Memo1.Lines.Add(Format('error on read changes: %d %s', [Error,
SysErrorMessage(Error)]));
Break
end;
P := 0;
Ret := WaitForMultipleObjects(2, events, False, 200);
case Ret of
WAIT_OBJECT_0: begin
end;
else begin
if GetOverlappedResult(wHandle, Overlap, TotalRead, True) then begin
pFileInfo := PFILE_NOTIFY_INFORMATION(Buffer);
end;
end;
end;
if TotalRead > 0 then begin
while P < TotalRead do begin
pFileInfo := PFILE_NOTIFY_INFORMATION(Buffer + P);
if (((pFileInfo^.Action and FILE_ACTION_ADDED) = FILE_ACTION_ADDED)
//or (((evnt^.mask and IN_ATTRIB)=IN_ATTRIB))
or (((pFileInfo^.Action and FILE_ACTION_MODIFIED) =
FILE_ACTION_MODIFIED))) then begin
FileName := Copy(String(@pFileInfo^.FileName), 1,
pFileInfo^.FileNameLength);
if (FileName <> '.') and (FileName <> '..') then begin
Memo1.Lines.Add(Format('Next:%d, Action:%s, Cookie:%d, Len:%d,
Name:%s',
[pFileInfo^.NextEntryOffset,
decodeMask(pFileInfo^.Action), pFileInfo^.FileNameLength, FileName]));
end;
end;
if pFileInfo^.NextEntryOffset = 0 then begin
FStopNotify := True;
Break;
end;
Inc(P, pFileInfo^.NextEntryOffset);
Application.ProcessMessages
end;
end;
end;
Application.ProcessMessages;
if not FindNextChangeNotification(wHandle) then begin
MessageDlg('Error','Invalid get next notification', mtError, [mbOK], 0,
mbOK);
Break
end;
end;
finally
if Assigned(PData) then
ReAllocMem(PData, 0);
FindCloseChangeNotification(wHandle)
end;
{$ENDIF}
{$IFDEF LINUX}
instance_handle := inotify_init;
try
if instance_handle = -1 then begin
MessageDlg('Error','Invalid notify handle', mtError, [mbOK], 0, mbOK);
Exit
end;
FStopNotify := False;
inotify_add_watch(instance_handle, PChar(FolderName),
IN_MODIFY+IN_CREATE+IN_DONT_FOLLOW);
while not FStopNotify do begin
fpFD_Zero(rfds);
fpFD_Set(instance_handle, rfds);
Ret := fpSelect (instance_handle+1, @rfds, nil, nil, Timeout);
if Ret < 0 then begin
MessageDlg('Error',Format('Return error for select (%d)', [Ret]),
mtError, [mbOK], 0, mbOK);
Break
end;
Application.ProcessMessages;
if Ret = 0 then
Continue;
Buffer := nil;
ReAllocMem(Buffer, buflen);
TotalRead := fpRead(instance_handle, Buffer, buflen);
P := 0;
while P < TotalRead do begin
evnt := pinotify_event(buffer + P);
if (((evnt^.mask and IN_MODIFY)=IN_MODIFY)
//or (((evnt^.mask and IN_ATTRIB)=IN_ATTRIB))
or (((evnt^.mask and IN_CREATE)=IN_CREATE)))
and (String(@evnt^.Name) <> '.') and (String(@evnt^.Name) <> '..') then
begin
Memo1.Lines.Add(Format('Wd:%d, Mask:%s, Cookie:%d, Len:%d, Name:%s',
[evnt^.Wd, decodeMask(evnt^.mask),
evnt^.cookie, evnt^.Len, pchar(@evnt^.Name)]));
end;
Inc(P, evnt^.len+16);
Application.ProcessMessages
end;
ReAllocMem(Buffer, 0);
end
finally
FpClose(instance_handle)
end;
{$ENDIF}
end;
procedure TFrmMain.StartNotify(const FolderName: String);
{$IFDEF LINUX}
function decodeMask(Mask:Longint):string;
var
Rslt:String;
begin
Rslt:='';
if (Mask and IN_ACCESS)=IN_ACCESS then
Rslt:=Rslt+' File was accessed.';
if (Mask and IN_MODIFY)=IN_MODIFY then
Rslt:=Rslt+' File was modified.';
if (Mask and IN_ATTRIB)=IN_ATTRIB then
Rslt:=Rslt+' Attribute was changed.';
if (Mask and IN_CLOSE_WRITE)=IN_CLOSE_WRITE then
Rslt:=Rslt+' Writtable file was closed.';
if (Mask and IN_CLOSE_NOWRITE)=IN_CLOSE_NOWRITE then
Rslt:=Rslt+' Unwrittable file was closed.';
if (Mask and IN_CLOSE)=IN_CLOSE then
Rslt:=Rslt+' File was closed.';
if (Mask and IN_OPEN)=IN_OPEN then
Rslt:=Rslt+' File was opened.';
if (Mask and IN_MOVED_FROM)=IN_MOVED_FROM then
Rslt:=Rslt+' File was moved from ';
if (Mask and IN_MOVED_TO)=IN_MOVED_TO then
Rslt:=Rslt+' File was moved to ';
if (Mask and IN_MOVE)=IN_MOVE then
Rslt:=Rslt+' File is moving';
if (Mask and IN_CREATE)=IN_CREATE then
Rslt:=Rslt+' Subfile was created';
if (Mask and IN_DELETE)=IN_DELETE then
Rslt:=Rslt+' Subfile was deleted';
if (Mask and IN_DELETE_SELF)=IN_DELETE_SELF then
Rslt:=Rslt+' Self was deleted';
if (Mask and IN_MOVE_SELF)=IN_MOVE_SELF then
Rslt:=Rslt+' Self was moved';
if (Mask and IN_UNMOUNT)=IN_UNMOUNT then
Rslt:=Rslt+' Filesystem was unmounted';
if (Mask and IN_Q_OVERFLOW)=IN_Q_OVERFLOW then
Rslt:=Rslt+' Event queued overflowed';
if (Mask and IN_IGNORED)=IN_IGNORED then
Rslt:=Rslt+' File was ignored';
if (Mask and IN_ONLYDIR)=IN_ONLYDIR then
Rslt:=Rslt+' Only watch the path if it is a directory';
if (Mask and IN_DONT_FOLLOW)=IN_DONT_FOLLOW then
Rslt:=Rslt+' Do not follow a sym link';
if (Mask and IN_MASK_ADD)=IN_MASK_ADD then
Rslt:=Rslt+' Add to the mast of an already existing watch';
if (Mask and IN_ISDIR)=IN_ISDIR then
Rslt:=Rslt+' Event occurred against dir';
if (Mask and IN_ONESHOT)=IN_ONESHOT then
Rslt:=Rslt+' Only send event once';
decodeMask:=Rslt;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
function decodeMask(Mask:Longint):string;
var
Rslt:String;
begin
Result := '';
if (Mask and FILE_ACTION_ADDED) = FILE_ACTION_ADDED then
Result := Result + ' file ADDED';
if (Mask and FILE_ACTION_REMOVED) = FILE_ACTION_REMOVED then
Result := Result + ' file REMOVED';
if (Mask and FILE_ACTION_MODIFIED) = FILE_ACTION_MODIFIED then
Result := Result + ' file CHANGED';
end;
{$ENDIF}
var
wFolderName: String;
FileName: String;
Timeout: Integer=200;
Buffer: PChar;
PData: Pointer;
P: Integer;
{$IFDEF LINUX}
Ret: Integer;
instance_handle: cint;
notify_handle: cint;
rfds: tfdset;
length: Integer;
iEvent: inotify_event;
buflen: Integer=(SizeOf(iEvent) + 16) * 512;
evnt: Pinotify_event;
TotalRead: TSsize;
FileName: String;
{$ENDIF}
{$IFDEF MSWINDOWS}
wHandle: THANDLE;
Ret: Integer;
Res: BOOL;
pFileInfo: PFILE_NOTIFY_INFORMATION;
buflen: DWORD=SizeOf(FILE_NOTIFY_INFORMATION) * 512;
TotalRead: DWORD;
Error: Integer;
Overlap: OVERLAPPED;
events: array[0..1] of THANDLE;
Ev1: TEvent;
Ev2: TEvent;
{$ENDIF}
begin
wFolderName := ExcludeTrailingPathDelimiter(Trim(FolderName));
{$IFDEF MSWINDOWS}
wHandle := FindFirstChangeNotificationA(PChar(wFolderName),
DWORD(LongBool(False)), FILE_NOTIFY_CHANGE_SIZE +
FILE_NOTIFY_CHANGE_LAST_WRITE);
try
if wHandle = INVALID_HANDLE_VALUE then begin
MessageDlg('Error','Invalid notify handle', mtError, [mbOK], 0, mbOK);
Exit
end;
Ev1 := TEvent.Create(nil, False, False, 'FEV1_tralala');
Ev2 := TEvent.Create(nil, False, False, 'FEV2_tralala');
events[0] := THANDLE(Ev1.Handle);
events[1] := THANDLE(Ev2.Handle);
FillMemory(@Overlap, SizeOf(OVERLAPPED), byte(#0));
Overlap.hEvent := THANDLE(Ev1.Handle);
FStopNotify := False;
PData := nil;
buflen := 32 * 1024;
ReAllocMem(PData, buflen);
//Buffer := system.Align(PData, 16);
Buffer := PData;
while not FStopNotify do begin
Ret := WaitForSingleObject(wHandle, 200);
if Ret = WAIT_OBJECT_0 then begin
FillMemory(PData, buflen, byte(#0));
Res := ReadDirectoryChangesW(wHandle, Buffer, buflen, False,
FILE_NOTIFY_CHANGE_FILE_NAME + FILE_NOTIFY_CHANGE_SIZE +
FILE_NOTIFY_CHANGE_LAST_WRITE, @TotalRead, @Overlap, nil);
if not Res then begin
Error := GetLastError;
FStopNotify := True;
Memo1.Lines.Add(Format('error on read changes: %d %s', [Error,
SysErrorMessage(Error)]));
Break
end;
P := 0;
Ret := WaitForMultipleObjects(2, events, False, 200);
case Ret of
WAIT_OBJECT_0: begin
end;
else begin
if GetOverlappedResult(wHandle, Overlap, TotalRead, True) then begin
pFileInfo := PFILE_NOTIFY_INFORMATION(Buffer);
end;
end;
end;
if TotalRead > 0 then begin
while P < TotalRead do begin
pFileInfo := PFILE_NOTIFY_INFORMATION(Buffer + P);
if (((pFileInfo^.Action and FILE_ACTION_ADDED) = FILE_ACTION_ADDED)
//or (((evnt^.mask and IN_ATTRIB)=IN_ATTRIB))
or (((pFileInfo^.Action and FILE_ACTION_MODIFIED) =
FILE_ACTION_MODIFIED))) then begin
FileName := Copy(String(@pFileInfo^.FileName), 1,
pFileInfo^.FileNameLength);
if (FileName <> '.') and (FileName <> '..') then begin
Memo1.Lines.Add(Format('Next:%d, Action:%s, Cookie:%d, Len:%d,
Name:%s',
[pFileInfo^.NextEntryOffset,
decodeMask(pFileInfo^.Action), pFileInfo^.FileNameLength, FileName]));
end;
end;
if pFileInfo^.NextEntryOffset = 0 then begin
FStopNotify := True;
Break;
end;
Inc(P, pFileInfo^.NextEntryOffset);
Application.ProcessMessages
end;
end;
end;
Application.ProcessMessages;
if not FindNextChangeNotification(wHandle) then begin
MessageDlg('Error','Invalid get next notification', mtError, [mbOK], 0,
mbOK);
Break
end;
end;
finally
if Assigned(PData) then
ReAllocMem(PData, 0);
FindCloseChangeNotification(wHandle)
end;
{$ENDIF}
{$IFDEF LINUX}
instance_handle := inotify_init;
try
if instance_handle = -1 then begin
MessageDlg('Error','Invalid notify handle', mtError, [mbOK], 0, mbOK);
Exit
end;
FStopNotify := False;
inotify_add_watch(instance_handle, PChar(FolderName),
IN_MODIFY+IN_CREATE+IN_DONT_FOLLOW);
while not FStopNotify do begin
fpFD_Zero(rfds);
fpFD_Set(instance_handle, rfds);
Ret := fpSelect (instance_handle+1, @rfds, nil, nil, Timeout);
if Ret < 0 then begin
MessageDlg('Error',Format('Return error for select (%d)', [Ret]),
mtError, [mbOK], 0, mbOK);
Break
end;
Application.ProcessMessages;
if Ret = 0 then
Continue;
Buffer := nil;
ReAllocMem(Buffer, buflen);
TotalRead := fpRead(instance_handle, Buffer, buflen);
P := 0;
while P < TotalRead do begin
evnt := pinotify_event(buffer + P);
if (((evnt^.mask and IN_MODIFY)=IN_MODIFY)
//or (((evnt^.mask and IN_ATTRIB)=IN_ATTRIB))
or (((evnt^.mask and IN_CREATE)=IN_CREATE)))
and (String(@evnt^.Name) <> '.') and (String(@evnt^.Name) <> '..') then
begin
Memo1.Lines.Add(Format('Wd:%d, Mask:%s, Cookie:%d, Len:%d, Name:%s',
[evnt^.Wd, decodeMask(evnt^.mask),
evnt^.cookie, evnt^.Len, pchar(@evnt^.Name)]));
end;
Inc(P, evnt^.len+16);
Application.ProcessMessages
end;
ReAllocMem(Buffer, 0);
end
finally
FpClose(instance_handle)
end;
{$ENDIF}
end;
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
