[Lazarus] Shell notifications

Thu Aug 22 13:33:25 CEST 2013

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.
-------------- next part --------------
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;