Regelmässig auf vorhandene Dateien prüfen

[H.Bothur]

Moin,

irgendwie fehlt mir gerade komplett das KnowHow oder überhaupt der Ansatz um zu suchen.

Ich möchte ein Programm starten und regelmässig alle x Minuten nachsehen ob in einem bestimmten Verzeichnis Dateien vorhanden sind.

Jetzt kann man das natürlich in einer Dauerschleife machen - ich fürchte aber das das Programm einfach zu viele Systemresourcen frisst. Wie macht man das denn am geschicktesten ??

Gruß
Hans

[DieDolly]

Versuch das mal mit einem Custom-Thread. Der Code ist von hier irgendwo
https://www.delphipraxis.net/181814-...hread-pas.html

Bei diesem Thread brauchst du im Execute keine Schleife. Stattdessen hast du eine ExecuteTimed-Prozedur die alle XYZ-Intervall-Millisekunden aufgerufen wird.
Systembelastung quasi gleich 0.

Delphi-Quellcode:

// Delphipraxis.net: https://www.delphipraxis.net/181814-thread-timer-einbinden-von-timerthread-pas.html
unit Shared.Thread.CustomThread;

interface

uses
 System.Classes, System.SyncObjs;

const
 TIMERTHREAD_INTERVAL_DEFAULT = 1000;
 TIMERTHREAD_ENABLED_DEFAULT = True;

type
 TCustomThread = class(TThread)
 private
  FCS: TCriticalSection;
  FEvent: TEvent;
  FInterval: Cardinal;
  FEnabled: Boolean;
  procedure SetInterval(const Value: Cardinal);
  function GetInterval: Cardinal;
  procedure SetEnabled(const Value: Boolean);
  function GetEnabled: Boolean;
 protected
  procedure Execute; override; final;
  procedure ExecuteTimed; virtual;
  procedure TerminatedSet; override; // ACHTUNG! Das gibt es erst ab Delphi XE2
 public
  constructor Create;
  destructor Destroy; override;

  property Interval: Cardinal read GetInterval write SetInterval default TIMERTHREAD_INTERVAL_DEFAULT;
  property Enabled: Boolean read GetEnabled write SetEnabled default TIMERTHREAD_ENABLED_DEFAULT;
 end;

implementation

{TCustomThread}

constructor TCustomThread.Create;
begin
 FCS := TCriticalSection.Create;
 FEvent := TEvent.Create(nil, False, False, '');

 inherited Create(False);

 FInterval := TIMERTHREAD_INTERVAL_DEFAULT;
 FEnabled := TIMERTHREAD_ENABLED_DEFAULT;
end;

destructor TCustomThread.Destroy;
begin
 inherited;

 FEvent.Free;
 FCS.Free;
end;

procedure TCustomThread.Execute;
var
 LInterval: Cardinal;
begin
 inherited;

 while not Terminated do
  begin
   if Enabled then
    LInterval := Interval
   else
    LInterval := INFINITE;

   if FEvent.WaitFor(LInterval) = TWaitResult.wrTimeout then
    ExecuteTimed;
  end;
end;

procedure TCustomThread.ExecuteTimed;
begin

end;

function TCustomThread.GetEnabled: Boolean;
begin
 FCS.Enter;
 try
  Result := FEnabled;
 finally
  FCS.Leave;
 end;
end;

function TCustomThread.GetInterval: Cardinal;
begin
 FCS.Enter;
 try
  Result := FInterval;
 finally
  FCS.Leave;
 end;
end;

procedure TCustomThread.SetEnabled(const Value: Boolean);
begin
 FCS.Enter;
 try
  if Value <> FEnabled then
   begin
    FEnabled := Value;
    FEvent.SetEvent;
   end;
 finally
  FCS.Leave;
 end;
end;

procedure TCustomThread.SetInterval(const Value: Cardinal);
begin
 FCS.Enter;
 try
  if Value <> FInterval then
   begin
    FInterval := Value;
    FEvent.SetEvent;
   end;
 finally
  FCS.Leave;
 end;
end;

procedure TCustomThread.TerminatedSet;
begin
 inherited;

 FEvent.SetEvent;
end;

end.

Von dieser Unit leitest du dir dann deine eigenen Threads einfach ab.

Delphi-Quellcode:

unit MyThread;

interface

uses
 ...,

 MyustomThread;

type
 TMyThread = class(TCustomThread)
 private
  {Private-Deklarationen}
 protected
  procedure ExecuteTimed; override;
 public
  {Public-Deklarationen}
  constructor Create;
 end;

implementation

constructor TMyThread.Create;
begin
 inherited Create;

 Interval := 5000; // rufe alle 5 Sekunden ExecuteTimed auf
 Enabled := True;
end;

procedure TMyThread.ExecuteTimed;
begin

end;

end.

[jaenicke]

Es macht keinen Sinn dafür mit Threads zu pollen. Stichwörter sind directory change notification, directory watch usw.

Damit bekommt man einfach Bescheid, wenn sich in einem Verzeichnis etwas ändert. Dafür gibt es auch für Delphi fertige Komponenten und Code.

[DieDolly]

Eine DirectoryWatch ist natürlich besser. Hier ist eine
Quelle: https://www.developpez.net/forums/at...rectorywatch./

Ich hefte den Code mal hier an, weil wenn man auf den Link klickt direkt ein Download startet.

Delphi-Quellcode:

(*
 * This software is distributed under BSD license.
 *
 * Copyright (c) 2009 Iztok Kacin, Cromis ([e-mail]).
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without modification,
 * are permitted provided that the following conditions are met:
 *
 * - Redistributions of source code must retain the above copyright notice, this
 *   list of conditions and the following disclaimer.
 * - Redistributions in binary form must reproduce the above copyright notice, this
 *   list of conditions and the following disclaimer in the documentation and/or
 *   other materials provided with the distribution.
 * - Neither the name of the Iztok Kacin nor the names of its contributors may be
 *   used to endorse or promote products derived from this software without specific
 *   prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
 * OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * NOTICE OF CODE ORIGIN
 *
 * This code was derived from the original code of author "Gleb Yourchenko"
 * The original code "FnugryDirWatch" can still be found at Torry Components
 * The URL is: http://www.torry.net/pages.php?id=252
 *
 * The code was taken as a starting point and then mainly written from scratch
 * keeping some of the healthy code parts. So I am not in any way an author of
 * the original idea. But I am the author of all the changes and new code parts.
 *
 * ============================================================================
 * 12/10/2009 (1.0.0)
 *  - Initial code rewrite from "FnugryDirWatch"
 * 16/01/2010 (1.0.1)
 *  - Refactored the main watch loop
 * ============================================================================
*)

unit DirectoryWatch;

interface

uses
   Windows, SysUtils, Classes, Messages, SyncObjs;

const
  FILE_NOTIFY_CHANGE_FILE_NAME   = $00000001;
  FILE_NOTIFY_CHANGE_DIR_NAME    = $00000002;
  FILE_NOTIFY_CHANGE_ATTRIBUTES  = $00000004;
  FILE_NOTIFY_CHANGE_SIZE        = $00000008;
  FILE_NOTIFY_CHANGE_LAST_WRITE  = $00000010;
  FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020;
  FILE_NOTIFY_CHANGE_CREATION    = $00000040;
  FILE_NOTIFY_CHANGE_SECURITY    = $00000100;

const
  cShutdownTimeout = 3000;
  
type
  // the filters that control when the watch is triggered
  TWatchOption = (woFileName, woDirName, woAttributes, woSize, woLastWrite,
                  woLastAccess, woCreation, woSecurity);
  TWatchOptions = set of TWatchOption;

  // the actions that are the result of the watch being triggered
  TWatchAction = (waAdded, waRemoved, waModified, waRenamedOld, waRenamedNew);
  TWatchActions = set of TWatchAction;

  TFileChangeNotifyEvent = procedure(const Sender: TObject;
                                     const Action: TWatchAction;
                                     const FileName: string
                                     ) of object;

  TDirectoryWatch = class
  private
    FWatchOptions : TWatchOptions;
    FWatchActions : TWatchActions;
    FWatchSubTree : Boolean;
    FWatchThread  : TThread;
    FWndHandle    : HWND;
    FDirectory    : string;
    FAbortEvent   : Cardinal;
    FOnChange     : TNotifyEvent;
    FOnNotify     : TFileChangeNotifyEvent;
    procedure WatchWndProc(var Msg: TMessage);
    procedure SetDirectory(const Value: string);
    procedure SetWatchOptions(const Value: TWatchOptions);
    procedure SetWatchActions(const Value: TWatchActions);
    procedure SetWatchSubTree(const Value: Boolean);
    procedure DeallocateHWnd(Wnd: HWND);
    function MakeFilter: Integer;
  protected
    procedure Change; virtual;
    procedure AllocWatchThread;
    procedure ReleaseWatchThread;
    procedure RestartWatchThread;
    procedure Notify(const Action: Integer;
                     const FileName: string
                     ); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    function Running: Boolean;
    property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
    property WatchOptions: TWatchOptions read FWatchOptions write SetWatchOptions;
    property WatchActions: TWatchActions read FWatchActions write SetWatchActions;
    property Directory: string read FDirectory write SetDirectory;
    // notification properties. Notify about internal and exernal changes
    property OnNotify: TFileChangeNotifyEvent read FOnNotify write FOnNotify;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

type
  PFILE_NOTIFY_INFORMATION = ^TFILE_NOTIFY_INFORMATION;
  TFILE_NOTIFY_INFORMATION = record
    NextEntryOffset : Cardinal;
    Action          : Cardinal;
    FileNameLength  : Cardinal;
    FileName        : array[0..MAX_PATH - 1] of WideChar;
  end;

const
  WM_DIRWATCH_ERROR    = WM_USER + 137;
  WM_DIRWATCH_NOTIFY   = WM_USER + 138;

  FILE_LIST_DIRECTORY  = $0001;

const
  // error messages
  cErrorInWatchThread = 'Error "%s" in watch thread. Error code: %d';
  cErrorCreateWatchError = 'Error trying to create file handle for "%s". Error code: %d';

const
  IO_BUFFER_LEN = 32 * SizeOf(TFILE_NOTIFY_INFORMATION);
  
type
  TDirWatchThread = class(TThread)
  private
     FWatchSubTree : Boolean;
     FAbortEvent   : Cardinal;
     FChangeEvent  : Cardinal;
     FWndHandle    : Cardinal;
     FDirHandle    : Cardinal;
     FDirectory    : string;
     FIOResult     : Pointer;
     FFilter       : Integer;
  protected
     procedure Execute; override;
  public
     constructor Create(const Directory: string;
                        const WndHandle: Cardinal;
                        const AbortEvent: Cardinal;
                        const TypeFilter: Cardinal;
                        const aWatchSubTree: Boolean);
     destructor Destroy; override;
  end;

procedure TDirWatchThread.Execute;
var
  NotifyData: PFILE_NOTIFY_INFORMATION;
  Events: array[0..1] of THandle;
  WaitResult: DWORD;
  NextEntry: Integer;
  ErrorMsg: PWideChar;
  FileName: PWideChar;
  Overlap: TOverlapped;
  ResSize: Cardinal;
begin
  FillChar(Overlap, SizeOf(TOverlapped), 0);
  Overlap.hEvent := FChangeEvent;

  // set the array of events
  Events[0] := FChangeEvent;
  Events[1] := FAbortEvent;

  while not Terminated do
  try
    if ReadDirectoryChangesW(FDirHandle, FIOResult, IO_BUFFER_LEN, FWatchSubtree, FFilter, @ResSize, @Overlap, nil) then
    begin
      WaitResult := WaitForMultipleObjects(2, @Events[0], FALSE, INFINITE);

      // check if we have terminated the thread
      if WaitResult <> WAIT_OBJECT_0 then
      begin
        Terminate;
        Exit;
      end;
      
      if WaitResult = WAIT_OBJECT_0 then
      begin
        NotifyData := FIOResult;

        repeat
          NextEntry := NotifyData^.NextEntryOffset;

          // get memory for filename and fill it with data
          GetMem(FileName, NotifyData^.FileNameLength + 2);
          Move(NotifyData^.FileName, Pointer(FileName)^, NotifyData^.FileNameLength);
          PWord(Cardinal(FileName) + NotifyData^.FileNameLength)^ := 0;

          // send the message about the filename information and advance to the next entry
          PostMessage(FWndHandle, WM_DIRWATCH_NOTIFY, NotifyData^.Action, LParam(FileName));
          Inc(DWORD(NotifyData), NextEntry);
        until (NextEntry = 0);
      end;
    end;
  except
    on E :Exception do
    begin
      GetMem(ErrorMsg, Length(E.Message) + 2);
      Move(E.Message, Pointer(ErrorMsg)^, Length(E.Message));
      PWord(Cardinal(ErrorMsg) + Cardinal(Length(E.Message)))^ := 0;
      PostMessage(FWndHandle, WM_DIRWATCH_ERROR, GetLastError, LPARAM(ErrorMsg));
    end;
  end;
end;

constructor TDirWatchThread.Create(const Directory: string;
                                   const WndHandle: Cardinal;
                                   const AbortEvent: Cardinal;
                                   const TypeFilter: Cardinal;
                                   const aWatchSubTree: Boolean);
begin
   //
   // Retrieve proc pointer, open directory to
   // watch and allocate buffer for notification data.
   // (note, it is done before calling inherited
   // create (that calls BeginThread) so any exception
   // will be still raised in caller's thread)
   //
   FDirHandle := CreateFile(PChar(Directory),
                            FILE_LIST_DIRECTORY,
                            FILE_SHARE_READ OR
                            FILE_SHARE_DELETE OR
                            FILE_SHARE_WRITE,
                            nil, OPEN_EXISTING,
                            FILE_FLAG_BACKUP_SEMANTICS OR
                            FILE_FLAG_OVERLAPPED,
                            0);

   if FDirHandle = INVALID_HANDLE_VALUE then
     raise Exception.CreateFmt(cErrorCreateWatchError, [Directory, GetLastError]);

   FChangeEvent := CreateEvent(nil, FALSE, FALSE, nil);
   FAbortEvent := AbortEvent;

   // allocate the buffer memory
   GetMem(FIOResult, IO_BUFFER_LEN);

   FWatchSubTree := aWatchSubtree;
   FWndHandle := WndHandle;
   FDirectory := Directory;
   FFilter := TypeFilter;

   // make sure we free the thread
   FreeOnTerminate := True;

   inherited Create(False);
end;


destructor TDirWatchThread.Destroy;
begin
   if FDirHandle <> INVALID_HANDLE_VALUE  then
     CloseHandle(FDirHandle);
   if Assigned(FIOResult) then
     FreeMem(FIOResult);

   inherited Destroy;
end;

{ TFnugryDirWatch }

procedure TDirectoryWatch.AllocWatchThread;
begin
  if FWatchThread = nil then
  begin
    FAbortEvent := CreateEvent(nil, FALSE, FALSE, nil);
    FWatchThread := TDirWatchThread.Create(Directory,
                                           FWndHandle,
                                           FAbortEvent,
                                           MakeFilter,
                                           WatchSubtree);
  end;
end;

procedure TDirectoryWatch.ReleaseWatchThread;
var
  AResult: Cardinal;
begin
  if FWatchThread <> nil then
  begin
    // set and close event
    SetEvent(FAbortEvent);
    CloseHandle(FAbortEvent);

    // wait and block until thread is finished
    AResult := WaitForSingleObject(FWatchThread.Handle, cShutdownTimeout);

    // check if we timed out
    if AResult = WAIT_TIMEOUT then
      TerminateThread(FWatchThread.Handle, 0);

    FWatchThread := nil;
  end;

end;

procedure TDirectoryWatch.RestartWatchThread;
begin
  Stop;
  Start;
end;

function TDirectoryWatch.Running: Boolean;
begin
  Result := FWatchThread <> nil;
end;

procedure TDirectoryWatch.DeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));

  if Instance <> @DefWindowProc then
  begin
    { make sure we restore the default
      windows procedure before freeing memory }
    SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
    FreeObjectInstance(Instance);
  end;

  DestroyWindow(Wnd);
end;

destructor TDirectoryWatch.Destroy;
begin
  Stop;
  DeallocateHWnd(FWndHandle);

  inherited Destroy;
end;

constructor TDirectoryWatch.Create;
begin
   FWndHandle := AllocateHWnd(WatchWndProc);
   FWatchSubtree := True;

   // construct the default watch actions and options
   FWatchActions := [waAdded]; //, waRemoved, waModified, waRenamedOld, waRenamedNew];
   FWatchOptions := [woFileName, woDirName, woAttributes, woSize, woLastWrite,
                     woLastAccess, woCreation, woSecurity];
end;



procedure TDirectoryWatch.SetWatchActions(const Value: TWatchActions);
begin
  if FWatchActions <> Value then
  begin
    FWatchActions := Value;

    if Running then
      RestartWatchThread;

    Change;
  end;
end;

procedure TDirectoryWatch.SetWatchOptions(const Value: TWatchOptions);
begin
  if FWatchOptions <> Value then
  begin
    FWatchOptions := Value;

    if Running then
      RestartWatchThread;

    Change;
  end;
end;

procedure TDirectoryWatch.WatchWndProc(var Msg :TMessage);
var
  ErrorCode: Cardinal;
  ErrorMessage: string;
begin
   case Msg.msg of
     WM_DIRWATCH_NOTIFY:
     //
     // Retrieve notify data and forward
     // the event to TDirectoryWatch's notify
     // handler. Free filename string (allocated
     // in WatchThread's notify handler.)
     //
     begin
        try
           Notify(Msg.wParam, WideCharToString(PWideChar(Msg.lParam)));
        finally
          if Msg.lParam <> 0 then
            FreeMem(Pointer(Msg.lParam));
        end;
     end;

     WM_DIRWATCH_ERROR:
     //
     // Disable dir watch and re-raise
     // exception on error
     //
     begin
        try
          ErrorMessage := WideCharToString(PWideChar(Msg.lParam));
          ErrorCode := Msg.WParam;
          Stop;

          raise Exception.CreateFmt(cErrorInWatchThread, [ErrorMessage, ErrorCode]);
        finally
          if Msg.lParam <> 0 then
            FreeMem(Pointer(Msg.lParam));
        end;
     end;
     //
     // pass all other messages down the line
     //
     else
     begin
       Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
       Exit;
     end;
   end;
end;

function TDirectoryWatch.MakeFilter: Integer;
const
  FilterFlags: array [TWatchOption] of Integer = (FILE_NOTIFY_CHANGE_FILE_NAME,
                                                  FILE_NOTIFY_CHANGE_DIR_NAME,
                                                  FILE_NOTIFY_CHANGE_ATTRIBUTES,
                                                  FILE_NOTIFY_CHANGE_SIZE,
                                                  FILE_NOTIFY_CHANGE_LAST_WRITE,
                                                  FILE_NOTIFY_CHANGE_LAST_ACCESS,
                                                  FILE_NOTIFY_CHANGE_CREATION,
                                                  FILE_NOTIFY_CHANGE_SECURITY);
var
  Flag: TWatchOption;
begin
  Result := 0;

  for Flag in FWatchOptions do
    Result := Result or FilterFlags[Flag];
end;

procedure TDirectoryWatch.SetWatchSubTree(const Value :Boolean);
begin
  if Value <> FWatchSubtree then
  begin
    FWatchSubtree := Value;

    if Running then
      RestartWatchThread;

    Change;
  end;
end;


procedure TDirectoryWatch.Start;
begin
  if FDirectory = '' then
    raise Exception.Create('Please specify a directory to watch');

  if not Running then
  begin
    AllocWatchThread;
    Change;
  end;
end;

procedure TDirectoryWatch.Stop;
begin
  if Running then
  begin
    ReleaseWatchThread;
    Change;
  end;
end;

procedure TDirectoryWatch.SetDirectory(const Value: string);
begin
  if StrIComp(PChar(Trim(Value)), PChar(FDirectory)) <> 0 then
  begin
    FDirectory := Trim(Value);

    if Running then
      RestartWatchThread;

    Change;
  end;
end;

procedure TDirectoryWatch.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TDirectoryWatch.Notify(const Action: Integer; const FileName: string);
begin
  if Assigned(FOnNotify) then
    if TWatchAction(Action - 1) in FWatchActions then
      FOnNotify(Self, TWatchAction(Action - 1), FileName);
end;

end.

[H.Bothur]

Vielen Dank !! Das werde ich die Tage einmal in Ruhe durcharbeiten !

Gruß
Hans

[freejay]

Oder ganz einfach: Man ruft die Suchroutine einfach einmal pro Minute per TTimer auf.

[jaenicke]

Zitat von freejay:

Oder ganz einfach: Man ruft die Suchroutine einfach einmal pro Minute per TTimer auf.

Es sauber umzusetzen macht aber mehr Sinn. Dann bekommt man Änderungen gleich mit und nicht erst beim nächsten Suchlauf und einfacher ist es zusätzlich noch.

Am einfachsten ist, wenn man TJvChangeNotify aus der JVCL benutzt. JCL und JVCL dürften die meisten ja ohnehin installiert haben. Die Komponente kann man einfach auf ein Formular oder Datenmodul legen, unter Notifications die zu überwachenden Verzeichnisse festlegen und das OnChangeNotify Event erstellen. Darin bekommt man dann das Verzeichnis mitgeteilt, in dem sich etwas geändert hat und die Information was sich dort geändert hat (Dateiname, Verzeichnisname, Attribute, Dateigröße, ...).

Mit TJvChangeNotify ist das eine Sache von 5 Minuten inkl. Test.