ReadDirectoryChangesW

[ManfredG]

Hallo Tom,
ich habe heute leider nicht den Nerv deinen Code zu überprüfen, hatte aber in der Vergangenheit schon mal ein ähnliches Problem und deshalb eine Komponente entwickelt. Vielleicht hilft dir das weiter.

Hier die Komponenten:

Delphi-Quellcode:

unit FldrControl;    

interface

uses
  Windows, SysUtils, Classes, cThread, SyncObjs;
// dieser Typ steht für die dwFilter-Konstanten von ReadDirectoryChangesW
// er ist erfoderlich, da die Filter-Konstanten nicht direkt verwendet werden können,
// da ihr Wertbereich 128 überschreitet und nicht mehr in einen SET OF passen
type
  opTyp  = set of (fncFileName,fncDirName,fncAttributes,fncSize,fncLastWrite,fncLastAccess,fncCreation,fncSecurity);
// die Funktion dient der Datenübergabe an ein übergeordnetes Fenster
Type
  TOnGetData = Procedure(Folder: String; Action: Integer) of Object;
{ Nichtvisuelle Komponente zur Ordnerüberwachung
  Properties:
    Folder - (lesen/schreiben) der Ordner, ab dem die Struktur überwacht werden soll
    ThreadExists - (lesen) TRUE, wenn der Überwachungsthread existiert
    ThreadSuspended - (lesen) TRUE, wenn der Thread suspendiert ist.
    CtrlTyp - (lesen/schreiben) Ersatz für dwFilter-Konstanten im Objektinspektor
    OnGetResult - Datenübergabeereignis
  Funktionen:
    Create, Destroy
    GetData - Verbindungsfunktion für Datenübergabe im Objektinspektor
    StartThread    - Start des Überwachungsthreads
    StopThread     - Beenden des Überwachungsthreads
    SuspendThread  - Suspendieren des Überwachungsthreads
    ResumeThread;  - Wiederaufnehme des Überwachungsthreads
}
type
  TFldrControl = class(TComponent)
  private   { Private-Deklarationen }
    ControlThread: CtrlThread; // Zeiger auf das Thread-Objekt
    FOrdnerName  : String;     // zu überwachender Ordner
    SuspEventName: String;     // benamter Event für die Einleitung von Suspend
    TermEventName: String;     // benamter Event für die Einleitung von Terminate
    FOnData      : TOnGetData;
    ThrdExists   : boolean;    // Kennzeichen für die Existenz des Threads
    wSelChg      : DWORD;      // Filter für ReadDirectoryChangesW
    TypSelChg    : opTyp;      // Alias für Filter (Objektinspektor)
  protected { Protected-Deklarationen }
    procedure      SetOrdnerName(NewFolder: String); // ändern Ordnername
    function       GetThreadStatus: boolean;         // Abfrage Threadstatus
    procedure      SetTypSelChg(Value: opTyp);       // ändern Filter
  public    { Public-Deklarationen }
    EvOrdner     : String;      // Rückgabedaten Ordnername bei Ereignis
    EvAction     : integer;     // Rückgabedaten Ereignis
    Constructor    Create(AOwner: TComponent); override;
    Destructor     Destroy; override;
    Procedure      StartThread;
    Procedure      StopThread;
    Procedure      SuspendThread;
    Procedure      ResumeThread;
    procedure      GetData;
    function       GetReason(const AdwReasonCode: DWORD): String;
  published { Published-Deklarationen }
    Property       Folder        : String  Read FOrdnerName write SetOrdnerName;
    Property       ThreadExists  : boolean read ThrdExists default TRUE;
    Property       ThreadSuspend : boolean read GetThreadStatus;
    Property       OnGetResult   : TOnGetData read FOnData write FOnData;
    Property       CtrlTyp       : opTyp read TypSelChg write SetTypSelChg;
  end;

procedure Register;
{*R *.res}
implementation

procedure Register;
begin
  RegisterComponents('Eigene', [TFldrControl]);
end;

Constructor TFldrControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlThread:=NIL;   // überflüssig
  ThrdExists   :=FALSE; // Ausgangssituation
  SetTypSelChg([fncFileName,fncDirName]); // Standartwert für Filter
end;

Destructor TFldrControl.Destroy;
begin
  inherited Destroy;
end;

// Umwandlung opTyp (SET OF) in DWORD für Filterkonstanten
procedure TFldrControl.SetTypSelChg;
var res: DWORD;
begin
  res:=0;
  if fncFileName   in Value then res:=res or FILE_NOTIFY_CHANGE_FILE_NAME;
  if fncDirName    in Value then res:=res or FILE_NOTIFY_CHANGE_DIR_NAME;
  if fncAttributes in Value then res:=res or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  if fncSize       in Value then res:=res or FILE_NOTIFY_CHANGE_SIZE;
  if fncLastWrite  in Value then res:=res or FILE_NOTIFY_CHANGE_LAST_WRITE;
  if fncLastAccess in Value then res:=res or FILE_NOTIFY_CHANGE_LAST_ACCESS;
  if fncCreation   in Value then res:=res or FILE_NOTIFY_CHANGE_CREATION;
  if fncSecurity   in Value then res:=res or FILE_NOTIFY_CHANGE_SECURITY;
  wSelChg:=res;
  TypSelChg:=Value;
  // nach einer Filteränderung muß der Thread eventuell neu gestartet werden!
  if not ThrdExists then Exit;  // außer er existiert nicht
  // wenn der Thread suspendiert ist..
  if ControlThread.Suspended then begin
    ControlThread.Resume; // dann aktivieren
    StopThread;           // vernichten
    StartThread;          // neu starten
  end else begin  // wenn er schon läuft
    StopThread;   // vernichten
    StartThread;  // neu starten
  end;
end;

// 
function TFldrControl.GetThreadStatus: boolean;
begin
  if   ThrdExists
  then Result:=ControlThread.Suspended
  else Result:=TRUE;
end;

procedure TFldrControl.SetOrdnerName;
begin
  FOrdnerName:=NewFolder;
  if not ThrdExists then Exit;
  if ControlThread.Suspended then begin
    ControlThread.Resume;
    StopThread;
    StartThread;
  end else begin
    StopThread;
    StartThread;
  end;
end;

procedure TFldrControl.GetData;
begin
  if Assigned(OnGetResult)
  then OnGetResult(EvOrdner,EvAction);
end;

Procedure   TFldrControl.StartThread;
var SelfName: String;
begin
  if ThrdExists then exit;
  if (Length(FOrdnerName)=0) or (Not DirectoryExists(FOrdnerName)) then begin
    MessageBox(0,'Ordner nicht angegeben','Fehler',MB_OK);
    Exit;
  end;
  if wSelChg=0 then begin
    MessageBox(0,'Überwachungskriterium nicht angegeben','Fehler',MB_OK);
    Exit;
  end;
  ControlThread:=CtrlThread.Create(self,FOrdnerName,wSelChg);
  ThrdExists   :=TRUE;
  SelfName     :=IntToStr(ControlThread.Handle);
  SuspEventname:=SelfName+'W';
  TermEventName:=SelfName+'N';
  ControlThread.SetEventNames(SuspEventname,TermEventName);
  ControlThread.Resume;
end;

Procedure   TFldrControl.StopThread;
var StopEvent: TEvent;
begin
  StopEvent:=TEvent.Create(nil,FALSE,FALSE,TermEventName);
  PulseEvent(StopEvent.Handle);
  StopEvent.Free;
  (**)// am 09.09.2007 zugefügt
      // wenn der Thread nicht durch Terminate vernichtet wird (FreeOnTerminate=TRUE)
      // bleibt er nach Änderung des Ordnernamens auf dem alten Ordner stehen !
  if ThrdExists then ControlThread.Terminate;
  (**)
  ThrdExists:=FALSE;
end;

Procedure   TFldrControl.SuspendThread;
var SuspEvent: TEvent;
begin
  SuspEvent:=TEvent.Create(nil,FALSE,FALSE,SuspEventName);
  SuspEvent.SetEvent;
  SuspEvent.ResetEvent;
  SuspEvent.Free;
end;

Procedure   TFldrControl.ResumeThread;
begin
  ControlThread.Resume;
end;

// Ereignisgrung in Text umwandeln
function TFldrControl.GetReason(const AdwReasonCode: DWORD): String;
begin
  case AdwReasonCode of
    FILE_ACTION_ADDED            : Result := 'hinzugefügt';
    FILE_ACTION_REMOVED          : Result := 'gelöscht';
    FILE_ACTION_MODIFIED         : Result := 'verändert';
    FILE_ACTION_RENAMED_OLD_NAME : Result := 'umbenannt. Alter Name.';
    FILE_ACTION_RENAMED_NEW_NAME : Result := 'umbenannt. Neuer Name.';
    else                           Result := 'Ungültiger Reason Code: '+IntToHex(AdwReasonCode,8);
  end;
end;

end.

Zu dieser Komponente gehört noch folgender Thread:

Delphi-Quellcode:

unit cThread;

interface

uses
  SysUtils, Classes, Controls, SyncObjs,  Windows, ShellApi, ComCtrls;

const
  FILE_LIST_DIRECTORY = $0001;
  WaitDir  = WAIT_OBJECT_0;
  WaitTerm = WAIT_OBJECT_0+1;
  WaitSusp = WAIT_OBJECT_0+2;

type
  CtrlThread = class(TThread)
  private
    FhFile     : DWORD;      // Handle von CreateFile auf die kontrollierte Ordnerstruktur
    FsDirPath  : string;     // der Pfad zu der Ordnerstruktur, die zu überwachen ist
    FsFileName : string;     // ein Dateiname aus einen Überwachungsereignis der Ordner
    FAction    : DWORD;      // Verzeichnisaktion, die erfolgte
    FileEvent  : THandle;    // Handle für das Ordnerüberwachungsereignis
    SuspEvent  : TEvent;     // Ereignis für das suspendieren des Threads
    SuspEvName : String;     // Name dieses Ereignisses
    TermEvent  : TEvent;     // eigenes Ereignis, das für den Abbruch des Threads erforderlich ist
    TermEvName : String;     // Name des Abbruchereignisses
    Owner      : TComponent; // Besitzer des Threads
    FFilter    : DWord;      // Filter für
    procedure    SendData;   // eine Beispielfunktion für die Datenübergabe
  public
    constructor Create(AOwner: TComponent; const AsDirPath: string; AFilter: DWORD);
    destructor  Destroy; override;
    procedure   Execute; override;
    Procedure   SetEventNames(AwEvName,AnEvName: string);
  end;

  PFILE_NOTIFY_INFORMATION = ^FILE_NOTIFY_INFORMATION; // Strukturzeiger
  FILE_NOTIFY_INFORMATION = packed record // Ereignisrecord für !ein! überwachungsereignis
    dwNextEntryOffset : DWORD;            // Offset zum nächsten Eintrag
    dwAction          : DWORD;            // Ereignisgrund
    dwFileNameLength  : DWORD;            // Länge des Dateinamens
    dwFileName        : WideString;       // Dateiname
  end;



implementation
uses FldrControl;

constructor CtrlThread.Create(AOwner: TComponent; const AsDirPath: string; AFilter: DWORD);
begin
  inherited Create(TRUE);       // Thread erstellen und nicht laufen lassen
  FsDirPath       := AsDirPath; // der zu überwachende Pfad
  Owner           := AOwner;    // der Besitzer des Threads
  FFIlter         := AFilter;   // Filter für .. übernehmen
  FreeOnTerminate := true;      // Thread nach Beendigung vernichten lassen
end;

// Namen für die Ereignisse:
// werden von der Komponente aus gesetzt, was aber erst geschehen kann,
// wenn der Thread creiert ist
Procedure CtrlThread.SetEventNames(AwEvName,AnEvName: String);
begin
  SuspEvName:=AwEvName;
  TermEvName:=AnEvName;
end;

procedure CtrlThread.Execute;
var
  pBuffer   : Pointer; // Puffer für die Rückgabedaten von ReadDirectoryChangesW
  dwBufLen  : DWORD;   // Größe des Puffers
  dwRead    : DWORD;   // Anzahl der Daten im Puffer
  PInfo     : PFILE_NOTIFY_INFORMATION; // Maske für die Pufferdaten
  dwNextOfs : DWORD;   // Position des Folgesatzes im Puffer (bei 0 - keiner)
  dwFnLen   : DWORD;   // Dateinamenlänge
  Overlap   : TOverlapped;  // Asynchronstruktur
  WaitResult: DWORD;   // Rückgabewert von WaitForMultipleObjects
  EventArray   : Array[0..2] of THandle; // Array der Handles für WaitForMultipleObjects
begin
  // Handle auf das zu überwachende Verzeichnis
  FhFile:= CreateFile(PChar(FsDirPath),
                      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;
  // Ereignis für Asynchronbehandlung von ReadDirectoryChangesW
  FileEvent:=CreateEvent(nil,FALSE,FALSE,nil);
  // Asynchronstruktur mit Ereignis besetzen
  Overlap.hEvent:=FileEvent;

  // Neues Ereignis erstellen, um später WaitForMultipleObjects abzubrechen
  // der Abbruch erfolgt von außen durch die Erzeugung des gleichen Events
  // welcher dann auf signaled gesetzt werden muß
  TermEvent:=TEvent.Create(nil,FALSE,FALSE,TermEvName);

  // Neues Ereignis erstellen, um später WaitForMultipleObjects abzubrechen
  // und den Thread auf suspendet zu setzen
  // der Abbruch erfolgt von außen durch die Erzeugung des gleichen Events
  // welcher dann auf signaled gesetzt werden muß
  SuspEvent:=TEvent.Create(nil,FALSE,FALSE,SuspEvName);

  // die drei Ereignishandles für WaitForMultipleObjects in ein Array füllen
  EventArray[0]:=FileEvent;         // Ordneränderung
  EventArray[1]:=TermEvent.Handle;  // Abbruch
  EventArray[2]:=SuspEvent.Handle;  // Suspend

  // Rückgabepuffer für ReadDirectoryChangesW erstellen
  dwBufLen     := 65535;
  pBuffer      := AllocMem(dwBufLen);
  try
    // Ablauf starten ...
    while not terminated do begin
      // Ordnerüberwachung asynchron erstellen
      dwRead:=0;
      if ReadDirectoryChangesW(FhFile,pBuffer,dwBufLen,true,
                               FFilter, //FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME,
                               @dwRead,@Overlap,NIL) then
      begin
        // unendliches warten bis eines der Ereignisse eintritt
        WaitResult:=WaitForMultipleObjects(3,@EventArray,FALSE,infinite);
        // wenn das Warten beendet wird, dann ...
        case WaitResult of
          // ... weil sich etwas in den Ordnern getan hat
          WaitDir: begin
                   // Maske über den Puffer legen, um auf die Daten zuzugreifen
                   PInfo:= pBuffer;
                   // und dies wiederholen ...
                   repeat
                     // Offset zum folgenden Datensatz
                     dwNextOfs :=PInfo.dwNextEntryOffset;
                     // Aktion, die im Ordnerbaum sattfand
                     fAction   :=PInfo.dwAction;
                     // Länge des betroffenen Ordners oder der Datei
                     dwFnLen   :=PInfo.dwFileNameLength;
                     // Dateinamen in AnsiString umsetzen
                     fsFileName:=WideCharLenToString(@PInfo.dwFileName,dwFnLen div 2);
                     // Daten in den Haupttread übergeben
                     Synchronize(SendData);
                     // Maske auf den nächsten Datensatz verschieben
                     pChar(PInfo):=pChar(PInfo)+dwNextOfs;
                     // wenn keiner mehr vorhanden ist, beenden
                   until dwNextOfs=0;
                 end;
          // ... oder das Abbruchereignis eingetreten ist
          WaitTerm: Terminate;
          // ... oder das Ereignis zum suspendieren eingetreten ist
          WaitSusp: Suspend;
          else break;
        end;
      end;
    end;
  finally
    FreeMem(pBuffer,dwBufLen);
  end;
end;

destructor CtrlThread.Destroy;
begin // diverse Handles freigeben
  try
    if FhFile <> INVALID_HANDLE_VALUE then CloseHandle(FhFile);
    CloseHandle(FileEvent);
    TermEvent.Free;
    SuspEvent.Free;
  except
  end;
end;

// Daten an das Control-Objekt übergeben
procedure CtrlThread.SendData;
begin
  TFldrControl(Owner).EvAction:=FAction;
  TFldrControl(Owner).EvOrdner:=fsFileName;
  // und dort die Benachrichtigungsfunktion aufrufen
  TFldrControl(Owner).GetData;
end;

end.

Also dann das Ganze als Komponente registrieren un in des Formulat legen.
Die Ereignisbehandlungsroutine aufbauen, Pfad setzen und mit StartTread aktivieren.

Gruß, Manfred