Thanks to visit codestin.com
Credit goes to github.com

Skip to content

How to use in graphic application? #3

@ziceptor

Description

@ziceptor

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

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions