type
TMyThread = class(TThread)
private
AHandle: THandle;
protected
procedure Execute; override;
public
Flr: string;
Running: boolean;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure Reaktion;
procedure StopThread;
procedure Manipulation;
function OK(var s: string): boolean;
function StartThread(s: string): boolean;
function ChngThreadFLR(s: string): boolean;
function EnableThread(b: boolean): boolean;
end;
var
Form1: TForm1;
Watch: TMyThread = nil;
implementation
{$R *.DFM}
{$B-}
uses FileCtrl;
procedure TForm1.FormCreate(Sender: TObject);
begin
if not StartThread('C:\') then
showmessage('Fehler beim Überwachungsstart.');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
StopThread;
end;
function TForm1.OK(var s: string): boolean;
begin
s := AnsiLowerCase(s);
if AnsiLastChar(s) <> '\' then s := s + '\';
result := directoryExists(s);
end;
function TForm1.StartThread(s: string): boolean;
begin
if OK(s) and (Watch = nil) then begin
Watch := TMyThread.create(true);
Watch.Running := true;
Watch.Flr := s;
Watch.Resume;
result := true;
end else result := false;
end;
procedure TForm1.StopThread;
begin
if Watch <> nil then begin
TerminateThread(Watch.Handle, 0);
Watch.free;
Watch := nil;
end;
end;
function TForm1.ChngThreadFLR(s: string): boolean;
begin
if (Watch <> nil) and OK(s) and (Watch.Flr <> s)
then begin
StopThread;
Application.ProcessMessages;
result := StartThread(s);
end else result := false;
end;
function TForm1.EnableThread(b: boolean): boolean;
begin
if Watch <> nil then begin
result := Watch.Running;
Watch.Running := b;
end else result := false;
end;
procedure TMyThread.Execute;
begin
AHandle := FindFirstChangeNotification(pchar(Flr), false,
FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_SIZE
or FILE_NOTIFY_CHANGE_LAST_WRITE or FILE_NOTIFY_CHANGE_DIR_NAME);
while not Terminated do begin
WaitForSingleObject(AHandle, INFINITE);
if Running then
Form1.Reaktion;
FindNextChangeNotification(AHandle);
end;
FindCloseChangeNotification(AHandle);
end;
procedure TForm1.Reaktion;
begin
// Hierher kommt alles, was passieren soll, wenn sich
// im überwachten Ordner etwas ändert.
// z.B.:
showmessage('Änderung');
end;
procedure TForm1.Manipulation;
var
notice: boolean;
begin
notice := EnableThread(false);
// Hierher kommen Dinge, die das Programm selbst
// im überwachten Ordner tun will, damit es keine
// Kollision mit dem Thread gibt.
// z.B. so etwas Ähnliches wie deletefile('c:\Test.tmp');
EnableThread(notice);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Überwachter Ordner wird gewechselt
if not ChngThreadFLR('C:\Programme') then
showmessage('Ordner nicht geändert');
end;