freepascal.ru

Здравствуйте!

Наткнулся на кроссплатформенные наработки по отслеживанию изменений в каталоге https://github.com/Wosi/DirectoryWatcher
Демка консольная работает, отслеживает каталог и подкаталоги. Как заставить работать в обычном приложении?

Пробовал так, но вызывается исключение 'External: SIGSEGV'.

Код: Выделить всё

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.

Ставлю на то, что валится при обращении к визуальной части из доп потока.
Если OnFileEvent работает из другого потока, то нельзя с LCL что-либо делать.

Код: Выделить всё

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


После изменения в каталоге файла (переименование и др.) валится на строке

Код: Выделить всё

WaitResult := WaitForMultipleObjects(Length(EventArray), @EventArray, False, INFINITE);

У меня работает (даже с Memo), но крашится на выходе и течёт.
Сейчас посмотрел, почему — там очень криво сделан выход из потока (хосспаде, зачем именованные события, а PulseEvent вообще никогда нельзя использовать, в MSDN прямо говорится, что это сломанная функция).

В качестве быстрого и грязного решения исправь в DirectoryWatcher.Windows.pas метод StopThread на вот это:

Код: Выделить всё

procedure TDirectoryWatcherWindows.StopThread;
var
   StopEvent: TEvent;
begin
   StopEvent := TEvent.Create(Nil, False, False, FTermEventName);
   StopEvent.SetEvent;
   Sleep(100);
   StopEvent.Free;
end;

По крайней мере, у меня после этого проблемы пропали. Но это всё равно неправильное решение: если не повезёт, Sleep'а не хватит.

Не советую использовать библиотеку, идея хорошая, но в реализации гонка на гонке сидит и пустым try-except'ом погоняет (в TDirectoryWatcherThreadWindows.Destroy). Меня ещё смущают приведения хэндлов к Integer, т. к. Windows-хэндл — это PtrUint, но у меня 32-битная система, поэтому не могу проверить.

P.S. Но да, в общем случае с Memo может не работать. Код, работающий с GUI из других потоков, нужно заворачивать в TThread.Synchronize, примерно так:

Код: Выделить всё

   TMainForm = class
      ...
      _filePath: string;
      _eventType: TDirectoryEventType;
      procedure OnFileEvent(const FilePath: String; const EventType: TDirectoryEventType);
      procedure OnFileEventSync;
      ...
   end;

   procedure TMainForm.OnFileEvent(const FilePath: String; const EventType: TDirectoryEventType);
   begin
      _filePath := FilePath;
      _eventType := EventType;
      TThread.Synchronize(nil, OnFileEventSync);
   end;

   procedure TMainForm.OnFileEventSync;
   var
      EventTypeString: String;
   begin
      Memo.Lines.Add('======NEW EVENT======');
      Memo.Lines.Add('File: ' + _filePath);

      case _eventType of
         detAdded: EventTypeString := 'ADDED';
         detRemoved: EventTypeString := 'REMOVED';
         detModified: EventTypeString := 'MODIFIED';
      end;

      Memo.Lines.Add('Type: ' + EventTypeString);
   end;

Synchronize заставляет операцию — зд. работу с Memo — выполниться согласованно с главным потоком, отвечающим за форму и вот это всё. В общем, сложно объяснить, но так надо.

А как бы Вы решили задачу отслеживания изменений в каталоге? Может в lazarus/fpc есть это "из коробки", а я и знать не знаю. Я замечал, что ide реагирует на файлы изменённые внешней программой.

Она так и решается, просто в данном модуле нужно поисправлять некоторые моменты (мне лень :).
Ещё гугл говорит, что в JEDI для этой же задачи сделан TJvChangeNotify, но я не уверен, есть ли это для Lazarus.

zi000000, Лазарус реагирует точно. Если временно не сломали.

Лекс Айрин писал(а):zi000000, Лазарус реагирует точно.

Он реагирует, но не так, как надо автору вопроса. Он реагирует только при получении фокуса. Можете проверить: скопируйте файл, открытый в редакторе Lazarus в укромное место, поиздевайтесь над ним как хотите, посохраняйте, главное - чтобы Lazarus фокус не получал! И верните файл на место как ни в чём не бывало. Lazarus после получения фокуса ничего даже не заподозрит!
Автору же надо именно что-то типа FindFirstChangeNotification. Windows-only решения у меня есть: для FindFirstChangeNotification и для ReadDirectoryChangesW - у меня эти решения в проектах работают адекватно. Но насчёт кроссплатформы - не знаю...