Verzeichnis überwachen & Dateiänderungsdatum prüfen

[Moombas]

Moin zusammen,

ich hänge grade bei einem totalen Knoten im Hirn, hoffe ihr könnt mir helfen.

Ich möchte in einem Verzeichnis so lange prüfen, ob eine neue Datei erstellt wurde und wenn er sie gefunden hat, diese als Ergebnis liefern (Dateinamen).
Danach soll er prüfen ob die Datei verändert wurde (ist sie länger als 30sek. nicht verändert worden, soll sie kopiert werden).

Ich hatte dabei erst an den Timer gedacht, der alle 5 Sekunden prüft ob es eine gibt, jedoch ist dies wie ich bisher feststellte unschön. Habt ihr dabei eine Idee, bin schon vieles durch gegangen an Tipps etc aus dem Internet aber spätestens beim Datum scheitert es, da ich dabei bisher immer ein falsches Datum & Uhrzeit erhalten habe.

Code:

procedure TTools.NewLog(Path : string); //Wird alle 5sek vom Timer ausgelöst - aTime ist nur global deklariert, um sie ausgeben zu können
var
  Date1, Date2, Date3: TDateTime;
  Datei : string;
begin
  if (Split(GetLastModifiedFileName(Path), '2', 0) = 'Log') or
     (Split(GetLastModifiedFileName(Path), '2', 0) = 'log') then
  begin
    Datei := GetLastModifiedFileName(Path);
    showmessage(Datei);
    showmessage(Datetimetostr(atime));
  end;
end;

function TTools.GetLastModifiedFileName(AFolder: String; APattern: String = '*.txt'): String;
var
  sr: TSearchRec;
begin
  Result := '';
  aTime := 0;
  if FindFirst(IncludeTrailingPathDelimiter(AFolder) + APattern, faAnyFile, sr) = 0 then
  begin
    repeat
      if sr.Time > aTime then
      begin
        aTime := sr.Time;
        Result := sr.Name;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

[rwalper]

Ich habe einen Hinweis zu Windows-Freigaben auf Netzlaufwerken. Seit dem SMB2-Protokoll werden die dortigen Dateien gecashed, so dass Du nur alle paar Minuten neue Dateien oder geänderte Dateiattribute mitbekommst.

Und was die Datei- und Verzeichnisüberwachung angeht, schau Dir unbedingt folgenden Thread oder auch andere dazu an:
https://www.delphipraxis.net/194309-...yregister.html

[günni0]

Vielleicht hilft dir diese Unit ja.

Eine quelle kann ich keine mehr nennen, da ich bei Google nur zwei seltsame Ergebnisse finde.
Jedoch ist die Unit von Iztok Kacin, Cromis ([e-mail]).

( Google-Suche )

[Moombas]

Erstmal schon mal danke für die Ratschläge.

Bei der Unit steige ich aber aktuell nicht durch. :cry:

[himitsu]

ReadDirectoryChangesW
FindFirstChangeNotification

ReadDirectoryChangesW
FindFirstChangeNotification
SHChangeNotifyRegister
...

https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

[günni0]

Zitat:

Zitat von Moombas (Beitrag 1398948)

Erstmal schon mal danke für die Ratschläge.

Bei der Unit steige ich aber aktuell nicht durch. :cry:

Du musst eine Instanz davon erstellen und dann im OnNotify-Event abfragen was passiert.

Ich erstelle später mal eine Demo.


Eine ganz normale Anwendung erstellen mit einem Button drauf.

Delphi-Quellcode:

unit Unit1;

interface

uses
 //...
 DirectoryWatch;

type
 TForm1 = class(TForm)
  Button1: TButton;
  procedure Button1Click(Sender: TObject);
 private
  Watch: TDirectoryWatch;
  procedure OnNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string);
 public
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string);
begin
 ShowMessage('Action: ' + TRttiEnumerationType.GetName(Action) + sLineBreak + sLineBreak + 'FileName:' + sLineBreak + FileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Path: string;
begin
 Path := ExtractFilePath(Application.ExeName) + '~TestVerzeichnis';

 if ForceDirectories(Path) then
  begin
   Watch := TDirectoryWatch.Create;
   Watch.WatchOptions := [woFileName, woDirName, woAttributes, woSize, woLastWrite, woLastAccess, woCreation, woSecurity]; // hier am besten selber herausfinden was du brauchst
   Watch.WatchActions := [waAdded, waRemoved, waModified, waRenamedOld, waRenamedNew]; // hier genau so
   Watch.Directory := Path;
   Watch.OnNotify := OnNotify;
   Watch.Start;
  end
 else
  MessageDlg('Verzeichnis konnte nicht erstellt werden', TMsgDlgType.mtError, [mbOK], 0);
end;

end.

[Der schöne Günther]

Ein guter Mann hier aus dem Forum hat da auch mal was verbrochen:

https://github.com/Wosi/DirectoryWatcher

[günni0]

Diese units kannte ich gar nicht.
Achtet die auch auf Änderungen der Dateigröße und sowas?
Die von mir genannte hat den Vorteil... es ist nur eine einzige Unit.

[KodeZwerg]

DirectoryWatch Quelle ;-)

[Moombas]

Danke schon mal, das sieht verständlicher aus.

@Günni, bei deinem Beispiel meckert er bei mir, das er die Unit "DirectoryWatch" nicht findet (irgendwie logisch, da ich sie ja nirgends habe) aber in deinem Beispiel soll sie ja in die uses(?).

Die Verweise auf die mega Codezeilen wie sie nun auch von Codezwerg gepostet wurde hilft mir leider nicht, da ich dort echt nicht durchsteige wie ich die Überwachung "aufrufe/starte" (beendet werden soll sie ja wenn er eine Datei findet, die erstellt wurde). Sry evtl. fehlt mir hier einfach das Verständnis.

[himitsu]

Die ReadDirectoryChangesW aus Post #3 nutzt ReadDirectoryChangesW und die reagiert auf verschiedene Änderungen, wie z.B.
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);

[günni0]

Zitat:

@Günni, bei deinem Beispiel meckert er bei mir, das er die Unit "DirectoryWatch" nicht findet (irgendwie logisch, da ich sie ja nirgends habe) aber in deinem Beispiel soll sie ja in die uses(?).

In Beitrag 3 habe ich sie angefügt.

Vorteil: eine einzige Unit, kann eigentlich alles.
Die hat zwar keine Interfaces, aber das sehe ich nicht als Nachteil. Denn nicht jeder ist des Verstehens von Interfaces mächtig und so kann meine angefügte Unit aus Beitrag 3 (Unit ist nicht von mir geschrieben) jeder erweitern.

[KodeZwerg]

Was ich geposted habe war die DirectoryWatch.pas in aktuellerer Version da die Quelle unbekannt war. Nun ist sie bekannt. (Ich beziehe mich auf Beitrag #3)

[günni0]

@Moombas

Einfach meine Unit aus Beitrag 3 runterladen und meine Demo angucken. Ist selbsterklärend.

Ansonsten hier als Anhang noch einmal alles komplett.

[Moombas]

@günni: hab das verpeilt mit der unit, dachte das nur der Programmiercode reicht. Aber mit der Unit bekomme ich die Fehlermeldung "TRttiEnumerationType" ist unbekannt, fehlt da eine andere unit?

Edit, habs gefunden System.Rtti fehlte in den uses

[günni0]

Das mit TRttiEnumerationType war nur für die Showmessage. Kann man rauslassen, weil man ja eh Action mit Case Action ... prüfen sollte.

[Moombas]

Jopp, ging aber erstmal darum, das es funktioniert ;) Hat mir auf jeden Fall schon mal enorm geholfen. Nun bekommen ich durch deine Hilfe den Filename, bin aber korrekt dabei, das ich für das Änderungsdatum der Datei eine neue eigene Routine brauche richtig?

[günni0]

Richtig. Das Datum wird nicht mitgeliefert. Es wird lediglich bekannt gemacht, dass es eine Änderung gab und welche. Weitere Daten muss man sich anhand des Dateinamens ("FileName") dann durch ergänzende Funktionalität zusammenbauen.
Falls das hier ein Profi ließt und ich Mist erzählte habe, korrigiere ich mich gerne.

[himitsu]

Im Allgemeinen kann man davon ausgehn, dass sich bei Inhaltänderung "standardmäßig" auch das Änderungsdatum ändert ... quasi nahezu identisch mit dem Zeitpunkt des Erhaltes der Änderungsmeldung.

[günni0]

Bei der von mir genannten Unit kann man auch als Abfrageoptionen woLastWrite, woLastAccess, woCreation auswählen.
Dann wird nur noch auf geänderte Daten geprüft.
(geht mit Wosis Unit selbstverständlich auch)

[Moombas]

Ich hab es durchaus mit deiner Abfrage mit waModified probiert aber hat bei Änderungen nicht reagiert bzw. soll sich ja explizit auf die vorher erstellte datei beziehen. Daher bin ich dafür wieder auf die Timerlösung umgestiegen. Wobei ich dort aktuell das Problem habe, das ich mit der Zeitausgabe nicht hinkomme (falsche Zeit, ich denke immer die aktuelle Systemzeit). Die Funktion habe ich allerdings nur kopiert und mich irritiert das Systemtime bei Encodedate.

Code:

function TTools.GetCreationTimeOfFile(const AFileName: String): TDateTime;
var
  SR: TSearchRec;
  SystemTime: TSystemTime;
  NewWriteTime: TFileTime;
begin
  Result:=0;
  if FindFirst(AFileName, faAnyFile, SR)=0 then
  try
    IF (FileTimeToLocalFiletime(SR.FindData.ftLastWriteTime, NewWriteTime) and
           FileTimeToSystemTime(NewWriteTime, SystemTime)) Then
    Result := Encodedate(SystemTime.wYear,
                         SystemTime.wMonth,
                         SystemTime.wDay) +
              Encodetime(SystemTime.wHour,
                         SystemTime.wMinute,
                         SystemTime.wSecond,
                         SystemTime.wMilliseconds);
  finally
    FindClose(SR)
  end;
end;

[günni0]

Zitat:

Ich hab es durchaus mit deiner Abfrage mit waModified probiert aber hat bei Änderungen nicht reagiert bzw. soll sich ja explizit auf die vorher erstellte datei beziehen.

waAdded

[Moombas]

Warum waAdded wenn ich schauen möchte ob eine Datei geändert/bearbeitet wurde? bei Added wäre ich bei erstellt oder hineinkopiert (das überwachen davon funktioniert ja schon dank deiner Hilfe). Oder verstehe ich da etwas falsch.

Bin bei Step 2: Schauen ob die erstellte Datei sich in den letzten 30sekunden gändert hat/ bearbeitet wurde.

[günni0]

Dann habe ich deinen Satz falsch verstanden.

[Moombas]

Macht ja nix :) Dennoch habe ich das oben genannte Problem mit der Zeit/Systemzeit. Auch kann ich "NewWriteTime" nicht umwandeln, bin da noch auf einer Lösungssuche.

Edit: Habe die Funktion nun geändert:

Code:

function TTools.GetFileChange(const AFileName: String): TDateTime;
var
  SR: TSearchRec;
  SystemTime: TSystemTime;
  NewWriteTime: TFileTime;
begin
  Result:=0;
  if FindFirst(AFileName, faAnyFile, SR)=0 then
  try
    IF (FileTimeToLocalFiletime(SR.FindData.ftLastWriteTime, NewWriteTime) and
           FileTimeToSystemTime(NewWriteTime, SystemTime)) Then
    Result := filetimetodatetime(newwritetime);
  finally
    FindClose(SR);
  end;
end;

Function TTools.FileTimeToDateTime(Const TimeIn : _FILETIME) : tDateTime;
Var
     DosTime    : Cardinal;
     Date               : Word;
     Time               : Word;
Begin
     FileTimeToDosDateTime(@TimeIn, Date, Time);
     DosTime := Cardinal(Date) Shl 16 + Time;
     Result := FileDateToDateTime(DosTime);
End;

Jetzt bekomme ich allerdings das "Erstellungsdatum/Zeit" der Datei.

Edit: Lösung gefunden :) Manchmal muss man seine eigene Logik in Frage stellen XD

[KodeZwerg]

So könntest Du auch die Information abfragen:

Delphi-Quellcode:

function GetFileLastWriteTime(Path: string; var LastWrite : TDateTime): Boolean;
var
  hFile: THandle;
  rStructur: TWin32FindData;
  rFileTime: TFileTime;
  dwLastWrite: Cardinal;
begin
  Result := False;
  hFile := Winapi.Windows.FindFirstFile(pchar(Path), rStructur);
  if hFile <> INVALID_HANDLE_VALUE
  then begin
    Winapi.Windows.FindClose(hFile);
    { FILETIME in lokales FILETIME-Format konvertieren }
    FileTimeToLocalFileTime(rStructur.ftLastWriteTime, rFileTime);
    { lokales FILETIME-Format ins DOS-Format konvertieren }
    FileTimeToDosDateTime(rFileTime, LongRec(dwLastWrite).Hi, LongRec(dwLastWrite).Lo);
    { DOS-Format in ein Delphi-Format konvertieren }
    LastWrite := FileDateToDateTime(dwLastWrite);
    Result := True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 DT: TDateTime;
begin
 if GetFileLastWriteTime(ParamStr(0), DT) then Label1.Caption := DateTimeToStr(DT);
end;

[Moombas]

Hi,

ich muss mal an mein Thema hier wieder anknüpfen.
Ich habe die Tage gezwungener Maßen Lazarus neuinstalliert (neue OS Installation) und daher die neueste Version genommen.

Leider habe ich nun ein Problem, wo ich partout nicht weiter komme.

Wenn ich eine Kopier Routine starte und damit auch eine Überwachung einer Datei funktioniert zunächst erst alles einwandfrei.
Wenn die Routine abgeschlossen ist und erneut (für den gleichen Ordner) gestartet wird erhalte ich eine Zugriffsverletzung (2ndRun.jpg), leider keine Debuggerausgabe :(.

Ich vermute das ich vergessen habe irgendeinen Zugriff/Thread oder so zu schließen, komme aber nicht drauf.

Hier der betreffende Code: (ich hoffe ich habe nichts vergessen):

Delphi-Quellcode:

procedure TTools.KopierenClick(Sender: TObject);
var
  buttonSelected : Integer;
  PfadA, PfadB   : WideString;
  i              : Integer;
begin
  Fail.Clear;
  Timer3.Interval  := strtoint(Delay.Text) * 1000;
 
  if (Programs.itemindex >= 0) and
     (Programs.Items[Programs.itemindex] <> '.') then
  begin
    if (Data.itemindex >= 0) and
       (split(Data.items[Data.itemindex],'.',1) = 'exe') then
    begin
      if SysUtils.DirectoryExists(KopierenE.Text + Programs.items[Programs.itemindex]) then
      begin
        if DatenC.Checked then
        begin
          StartCopy();
        end else if OriginalE.text <> InstallE.Text then
        begin
          buttonSelected := messagedlg('Das Programm existiert bereits im Installationsordner. Überschreiben?',mtCustom, [mbYes,mbCancel], 0);
          if buttonSelected = mrYes then
          begin
            StartCopy();
          end;
        end else
        begin
          StartCopy();
        end;
      end else
      begin
        StartCopy();
      end;
      LastList.LoadFromFile(KopierenE.Text + Programs.items[Programs.itemindex] + '\test.txt');
      Last.Enabled := True;
    end else if HinweisC.Checked = False then
    begin
      showmessage('Es wurde keine Exe gewählt.');
    end;
 
    PfadA := PfadP + WideString(Programs.items[Programs.itemindex]) + WideString('\test.txt');
    PfadB := WideString(InstallE.Text + Programs.items[Programs.itemindex] + '\test.txt');
    copyfile(PWideChar(PfadA), PWideChar(PfadB), false);
    BezirkS.Enabled    := False;
    FilialeC.Enabled   := False;
    FilialenPS.Enabled := False;
    Manuell.Enabled    := False;
    Last.Enabled       := False;
    DatenC.Enabled     := False;
    FertigC.Enabled    := False;
    LogC.Enabled       := False;
    StartP.Enabled     := False;
    Escape.Enabled     := True;
 
  end else if HinweisC.Checked = False then
  begin
    showmessage('Es wurde kein Programm gewählt.');
  end;
end;
 
//Kopieren starten
procedure TTools.StartCopy();
var
  Status : Bool;
begin
  delete(Widestring(KopierenE.Text + Programs.items[Programs.itemindex]));
  Status := copydir(PfadP + WideString(Programs.items[Programs.itemindex]), WideString(KopierenE.Text));
  if Status then
  begin
    sFileAction      := 'Create';
    Kopieren.Enabled := False;
    NewLog(Widestring(KopierenE.Text + Programs.items[Programs.itemindex]));
    Progress.Visible := True;
    Progress.Position:= 0;
    ProgressTimer.Enabled := True;
    if StartP.checked then
    begin
      startasUser(WideString(KopierenE.Text + Programs.items[Programs.itemindex] + '\' + Data.items[Data.itemindex]), KopierenE.Text + Programs.items[Programs.itemindex] + '\');
    end else
    begin
      Run.Enabled := True;
    end;
  end;
end;    
 
//Prozess als bestimmten Benutzer starten (Hilfsaufruf)
procedure TTools.startasUser(exe: Widestring; param: string);
var
  User              : WideString;
  PW                : WideString;
  err               : DWORD;
begin
  User := 'Test';
  PW   := 'PW';
  err  := CreateProcessAsLogon(User, PW, exe, WideString(param), '');
  if err <> 0 then
  begin
    ShowMessage(SysErrorMessage(err));
  end;
end;  
 
function TTools.CreateProcessAsLogon(const User, PW, Application, param, CmdLine: WideString): DWORD;
var
  ws  : WideString;
  si  : TStartupInfoW;
  pif : TProcessInformation;
begin
  ZeroMemory(@si, sizeof(si));
  si.cb := sizeof(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := 1;
 
  if CmdLine = '' then
  begin
    ws := Application;
  end else
  begin
    ws := Application + ' "' + CmdLine + '"';
  end;
 
  SetLastError(0);
  SI.cb  := SizeOf(TStartupInfo);
  if CreateProcessWithLogonW(PWideChar(User), nil, PWideChar(PW), 0, nil, PWideChar(ws), CREATE_DEFAULT_ERROR_MODE, nil, PWideChar(param), @si, @pif) then
  begin
    sleep(500);
    if PIf.dwProcessId > 0 then
    begin
      AppPID := PIf.dwProcessId;
      CloseHandle(PIf.hProcess);
      CloseHandle(PIf.hThread);
    end;
  end;
  Result := GetLastError;
end;
 
function CreateProcessWithLogonW(lpUsername, lpDomain, lpPassword: LPWSTR; dwLogonFlags: dword; lpApplicationName,
  lpCommandLine: LPWSTR; dwCreationFlags: dword; lpEnvironment: pointer; lpCurrentDirectory: LPWSTR; lpStartupInfo:
  PStartUpInfoW; lpProcessInfo: PProcessInformation): boolean; stdcall; external 'advapi32.dll';
 
procedure TTools.OnNotifySynchronized();
begin
  Timer3.Enabled := true;
end;      
 
procedure TTools.OnNotify(const FilePath: WideString; const Action: TDirectoryEventType);
var
  start, i : integer;
  FileName : WideString;
begin
  FileName := '';
  start := 1;
  for i := length(FilePath) downto 1 do
  begin
    if FilePath[i] = '\' then
    begin
      start := i + 1;
      break;
    end;
  end;
 
  for i := start to length(FilePath) do
  begin
    FileName := FileName + FilePath[i];
  end;
 
  if (Split(String(FileName), '2', 0) = 'Log') or
     (Split(String(FileName), '2', 0) = 'log') then
  begin
    case Action of
      detAdded: begin
                  Instant.Enabled := True;
                  Run.Enabled     := False;
                  LogL.Caption    := String(Filename + ' gefunden.');
                  LogL.Left       := 72;
                  LogA.Caption    := 'Logdatei prüfen...';
                  LogA.Show;
                  sFileAction     := 'Edited';
                  //Watch.Stop;
                  //Watch.Destroy
                  LogDatei        := Filename;
                  LogName         := FilePath;
                  LogA.Caption    := DateTimeToStr(ReportFileTimes(LogName));
                  LogA.Left       := 72;
                  FileChange      := ReportFileTimes(LogName);
                  olddate         := FileChange;
                  TThread.Synchronize(nil, OnNotifySynchronized);
                end;
      detRemoved: ;
      detModified: ;
    end;
  end;
end;
 
procedure TTools.NewLog(Path : WideString);
begin
  if sFileAction = 'Create' then
  begin
    if SysUtils.ForceDirectories(Path) then
    begin
      LogL.Caption       := 'Auf Log Datei warten...';
      LogL.Show;
      Programs.Enabled   := False;
      Data.Enabled       := False;
      TxTLogs.Enabled    := False;
      Watch              := TDirectoryWatcherBuilder.New
                                                    .WatchDirectory(Path)
                                                    .Recursively(False)
                                                    .OnChangeTrigger(OnNotify)
                                                    .Build;
      Watch.Start;
    end else
    begin
      MessageDlg('Verzeichnis konnte nicht erstellt werden', TMsgDlgType.mtError, [mbOK], 0);
    end;
  end;
end;  
 
procedure TTools.Timer3Timer(Sender: TObject);
  function GetProcessHandleFromID(ID: DWORD): THandle;
  begin
    result := OpenProcess(SYNCHRONIZE, False, ID);
    CloseHandle(result);
  end;
begin
  if fileexists(String(LogName)) then
  begin
    newdate := ReportFileTimes(WideString(LogName));
    if newdate <> olddate then
    begin
      olddate := newdate;
      Timer3.Enabled := True;
    end else if AppPID <> 0 then
    begin
      if GetProcessHandleFromID(AppPID) = 0 then
      begin
        Timer3.Enabled   := False;
        Progress.Visible := False;
        ProgressTimer.Enabled := False;
        if FertigC.Checked then
        begin
          FertigClick(Sender);
        end else
        begin
          Fertig.Enabled := True;
        end;
        Run.Enabled      := False;
        Programs.Enabled := True;
        Data.Enabled     := True;
        TxTLogs.Enabled  := True;
        Escape.Enabled   := False;
        LogA.Caption     := 'Programm fertig.';
        Timer3.Enabled   := False;
        AppPID           := 0;
      end;
    end else
    begin
      showmessage('Es wurde kein Programm gefunden!');
      Timer3.Enabled   := False;
      Progress.Visible := False;
      ProgressTimer.Enabled := False;
      if FertigC.Checked then
      begin
        FertigClick(Sender);
      end else
      begin
        Fertig.Enabled := True;
      end;
      Run.Enabled      := False;
      Programs.Enabled := True;
      Data.Enabled     := True;
      TxTLogs.Enabled  := True;
      Escape.Enabled   := False;
      LogA.Caption     := 'Programm nicht gefunden!';
      Timer3.Enabled   := False;
    end;
  end;
end;

[Moombas]

Wiseo kann ich meinen obigen Beitrag nicht bearbeiten -.- Ich habe eine Codezeile vergessen mit reinzukopieren...

Habe eben aber den Fehler gefunden, er lag in der Lösch-Routine.