Verzeichnis überwachen & Dateiänderungsdatum prüfen

[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.