Verzeichnis überwachen & Dateiänderungsdatum prüfen

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