"FindFirstChangeNotifikation" neu anstoßen

[Christian Seehase]

Moin Soulies,

bei einer Funktion, die was mit First heisst, und mit Close beendet wird, es auch eine mit Next geben, in diesem Falle:

FindNextChangeNotification



Schau Dir mal folgendes Beispiel an.
Dazu benötigst Du einen Formular, und zwei Button, der Rest steht (hoffentlich ) drin.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TcsDirWatchThread = class(TThread)
  private
    FsDirToWatch : string;
    procedure MyShowMessage;
  public
    constructor Create(const AsFolder : string);
    procedure Execute; override;
  end;

type
  TfrmMain = class(TForm)
    btnResume: TButton;
    btnSuspend: TButton;
    procedure btnResumeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSuspendClick(Sender: TObject);
  private
    { Private declarations }
    FDWT : TcsDirWatchThread;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TcsDirWatchThread }

constructor TcsDirWatchThread.Create(const AsFolder: string);
begin
  inherited Create(true);
  if not DirectoryExists(AsFolder) then raise Exception.CreateFmt('Datei %s nicht gefunden.',[AsFolder]);
  FsDirToWatch := AsFolder;
end;

procedure TcsDirWatchThread.Execute;

var
  dwFCN : DWORD;

begin
  dwFCN := FindFirstChangeNotification(PChar(FsDirToWatch),false,FILE_NOTIFY_CHANGE_FILE_NAME);
  if dwFCN = INVALID_HANDLE_VALUE then raise Exception.CreateFmt('FindFirstChangeNotification fehlgeschlagen.'#13#10'FM: %s',[SysErrorMessage(GetLastError)]);
  try
    while not Terminated do begin
      case WaitForSingleObject(dwFCN,1000) of
        WAIT_OBJECT_0 : begin
          // Mach was mit der Meldung
          Synchronize(MyShowMessage);
        end;
      end;
      FindNextChangeNotification(dwFCN);
    end;
  finally
    FindCloseChangeNotification(dwFCN);
  end;
end;

procedure TcsDirWatchThread.MyShowMessage;
begin
  ShowMessage('Ausgelöst');
end;

procedure TfrmMain.btnResumeClick(Sender: TObject);
begin
  FDWT.Resume;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FDWT := TcsDirWatchThread.Create('C:\temp');
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FDWT.Terminate;
  FDWT.Free;
end;

procedure TfrmMain.btnSuspendClick(Sender: TObject);
begin
  FDWT.Suspend;
end;

end.