// Mit dem folgenden Code kann man Aktivitäten (Löschen, Umbenennen
//
Ändern, Erstellen) in einem speziellen Ordner Überwachen.


// Getestet mit D4 unter XP

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;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke