Festplattenzugriffe

[Luckie]

Hallo Christian. Ich habe es jetzt so:

Delphi-Quellcode:

procedure TcsDirThread.Execute;
var
  pBuf              : Pointer;
  pWork             : Pointer;
  dwBufLen          : DWORD;
  dwDummy           : DWORD;
  sResult           : string;
  FNI               : FILE_NOTIFY_INFORMATION;
  dwRead            : DWORD;
  dwKey             : DWORD;
  pOVL              : POVERLAPPED;
  iCopyLen          : integer; // Prevent Buffer Overflow
begin
  // Normalerweise im Konstruktor erzeugt
  FhFile := CreateFile(PChar(FsDirPath), 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);
  FhComPort := CreateIoCompletionPort(FhFile, 0, $1234ABCD, 0);
  FillChar(Fovl, SizeOf(Fovl), 0);
  // Execute
  pOVL := @Fovl;
  dwBufLen := 65536;
  GetMem(pBuf, dwBufLen);
  try
    while not Terminated do
    begin
      ZeroMemory(pBuf, dwBufLen);
      if not ReadDirectoryChangesW(FhFile, pBuf, dwBufLen, true, FILE_NOTIFY_CHANGE_LAST_WRITE, @dwDummy, @Fovl, nil)
        then
        Terminate;
      if Terminated then
        break;
      if not GetQueuedCompletionStatus(FhComPort, dwRead, dwKey, pOVL, INFINITE) then
      begin
        Terminate;
      end
      else
      begin
        if Terminated then
          break;
        pWork := pBuf;
        repeat
          CopyMemory(@FNI, pWork, 12);
          iCopyLen := FNI.dwFileNameLength;
          if iCopyLen > _iFilenameLength then
            iCopyLen := _iFilenameLength;
          CopyMemory(@FNI.wFilename[1], PChar(pWork) + 12, iCopyLen);
          PChar(pWork) := PChar(pWork) + FNI.dwNextEntryOffset;
          FsReason := GetReason(FNI.dwAction);

          if FNI.dwAction = FILE_ACTION_ADDED then
          begin
            Synchronize(AddReasonToMemo);
            Synchronize(AddFileToMemo);
            FError := MoveChangedFiles(FFPATH + FsFileName);
            if FError <> 0 then
              Synchronize(AddErrorToMemo);
          end;
          
        until FNI.dwNextEntryOffset = 0;
        SetLength(sResult, iCopyLen);
        ZeroMemory(@sResult[1], length(sResult));
        (*if WideCharToMultiByte(GetACP, WC_NO_BEST_FIT_CHARS, @FNI.wFilename, iCopyLen, @sResult[1], iCopyLen, nil, nil)
          <> 0 then
        begin
        end;*)
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
  // Destruktor
  if (FhFile <> INVALID_HANDLE_VALUE) and (FhFile <> 0) then
    CloseHandle(FhFile);
  if FhComPort <> 0 then
    CloseHandle(FhComPort);
end;

Aber wenn ich debugge und einen Breakpunkt auf die Zeile 42 setze, dann kommt er nie dort an, weil er von GetQueuedCompletionStatus nie zurückkommt. :(

[Christian Seehase]

Moin Luckie,

teil das doch erst einmal so auf, dass die Teile die in den Konstruktor sollten auch da hinkommen, analog gilt dass dann natürlich auch für die Zeilen, die in den Destruktor gehören.
(Die mit F beginnenden Variablen sind private Felder der Klasse)
Ausserdem solltest Du noch die Filterbedingung (FILE_NOTIFY_CHANGE_LAST_WRITE usw.) Deinen Erfordernissen anpassen, denn wenn GetQueuedCompletionStatus nicht zurückkehrt, ist bislang keine der Bedingungen eingetreten.

[Luckie]

So getan. Nur bekomme ich jetzt jedes mal ein "Zugriff verweigert", während hingegen die aller werste Version funktioniert hat bei einzelnen Dateien. Im Memo sehe ich aber jetzt alle Dateien. :gruebel: Irgned wie hat eine API Funktion noch ihre Finger auf der datei, wenn ich sie verschieben will. :?

[Christian Seehase]

Moin Luckie,

da stellt sich mir dann die Frage, wie die Dateien da hinkommen, von wo Du sie verschieben willst.

[Luckie]

Also zu Testzwecken verschiebe ich sie lokal in das Verzeichnis, was ich über die Freigabe überwache: '\\Nestor\Sambafreigabe'. Letztendlich liegt das verzeichnis aber auf einem Linux Laufwerk, welches über eine Sambafreigabe zu erreichen ist. Die Daten die da abgelegt werden, kommen von einem Drucker. Kommt eine neue hinzu, muss sie auf den lokalen Rechner verschoben werden.

[Luckie]

Ich werden nachher mal probieren, was passiert, wenn ich sie erst kopiere und dann lösche, ob das funktioniert.

[Luckie]

So erste Problem ist gelöst. Wenn ich ein Ereigniss auslöse dann kann ich auch gleichzeitig miot dem Explorer mehrere Dateien in die Freigabe verschieben und er bekommt alles mit. Er kopiert auch alle Dateien, so wie er es soll. Nur löschen kann ich sie nicht, weil mir der Zugriff verweigert wird. Dafür bräuchte ich auch noch eine Lösung.

[Luckie]

Das zweite Problem mit dem Löschen besteht immer noch und ich bräuchte dafür eine Lösung. Bisher sieht es so aus:

Delphi-Quellcode:

procedure TcsDirThread.Execute;
const
  WC_NO_BEST_FIT_CHARS = $00000400;
var
  pBuf              : Pointer;
  pWork             : Pointer;
  dwBufLen          : DWORD;
  dwDummy           : DWORD;
  FNI               : FILE_NOTIFY_INFORMATION;
  dwRead            : DWORD;
  dwKey             : DWORD;
  pOVL              : POVERLAPPED;
  iCopyLen          : integer; // Prevent Buffer Overflow
begin
  pOVL := @Fovl;
  dwBufLen := 65536;
  GetMem(pBuf, dwBufLen);
  try
    while not Terminated do
    begin
      ZeroMemory(pBuf, dwBufLen);
      if ReadDirectoryChangesW(FhFile, pBuf, dwBufLen, true,
        //FILE_NOTIFY_CHANGE_FILE_NAME or
        //FILE_NOTIFY_CHANGE_DIR_NAME or
        FILE_NOTIFY_CHANGE_ATTRIBUTES or
        FILE_NOTIFY_CHANGE_SIZE or
        FILE_NOTIFY_CHANGE_LAST_WRITE or
        FILE_NOTIFY_CHANGE_LAST_ACCESS or
        FILE_NOTIFY_CHANGE_CREATION {or
        FILE_NOTIFY_CHANGE_SECURITY},
        @dwDummy, @Fovl, nil) then
      begin
        if Terminated then
          break;
        if not GetQueuedCompletionStatus(FhComPort, dwRead, dwKey, pOVL, INFINITE) then
        begin
          Terminate;
        end
        else
        begin
          if Terminated then
            break;
          pWork := pBuf;
          repeat
            CopyMemory(@FNI, pWork, 12);
            iCopyLen := FNI.dwFileNameLength;
            if iCopyLen > _iFilenameLength then
              iCopyLen := _iFilenameLength;
            CopyMemory(@FNI.wFilename[1], PChar(pWork) + 12, iCopyLen);
            PChar(pWork) := PChar(pWork) + FNI.dwNextEntryOffset;
            FsReason := GetReason(FNI.dwAction);
            FsFileName := TrimString(FNI.wFilename);
            // raise event
            if Assigned(OnDirectoryChanges) then
              FOnDirectoryChanges(self, FsFileName, FsReason);

          until FNI.dwNextEntryOffset = 0;
        end;
      end
      else
      begin
        if Assigned(OnDirectoryChangesError) then
          FOnDirectoryChangesError(self, GetLastError, SysErrorMessage(GetLastError));
        Terminate;
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
end;

Ändert sich etwas, wird also ein Event ausgelöst in dem ich auf die Änderung reagiere:

Delphi-Quellcode:

{*
 *  Procedure: TForm1.MyOnDirectoryChanges
 *  Change occured
 *  Author    : michael.puff
 *  Date      : 2006-03-10
 *}
procedure TForm1.MyOnDirectoryChanges(Sender: TObject; const Filename,
  Reason: string);

  function GetProjectPath: String;
  begin
    result := copy(ExtractFilepath(ParamStr(0)), 1, length(ExtractFilepath(ParamStr(0))) - 4);
    //ShowMessage(result);
  end;

begin
  Memo1.Lines.Add(Format('neue / geänderte Datei %s [%s]', [Trim(Filename), Reason]));
  if CopyFile(PChar(DIRPATH + '\' + Filename), PChar(GetProjectPath + '\' + Filename), False) then
  begin
    Memo1.Lines.Add(Format('Datei %s kopiert', [Filename]));
    Memo1.Refresh;
    Sleep(2000);
    Application.ProcessMessages;
    if DeleteFile(DIRPATH + '\' + Filename) then
      Memo1.Lines.Add(Format('Datei %s gelöscht', [Filename]))
    else
      Memo1.Lines.Add(Format('Fehler beim Löschen von Datei %s [%s]', [Filename, SysErrorMessage(GetLastError)]));
  end
  else
    Memo1.Lines.Add(Format('%s [%s]', [Filename, SysErrorMessage(GetLastError)]));
end;

Aber leider bekomme ich beim Löschen immer ein "Zugriff verweigert". Die Überwachung erst zu unterbrechen, die Dateien zu löschen und dann die Überwachung wieder zu starten, ist leider nicht so schön, da während der Unterbrechung neue dateien hinzugekommen sein könnten. Dies müsste ich dann auch behandlen und würde einen zusätzlichen Verwaltungsaufwand bedeuten. Was sehr unschön wäre.

[Luckie]

So, ich habe jetzt die Events synchronisiert, was allerdings immer noch nichts an dem Problem äöndert. Hat jemand eine Idee woran das liegen könnte und wie man dem Abhilfe schaffen könnte? Mit dem Explorer geht das Löschen, wenn das Verzeichnis überwacht wird ohne Probleme. Also wie schafft es der Explorer?

[Christian Seehase]

Moin Luckie,

versuche doch mal die Datei(en) mit SHFileOperation zu löschen, und nicht mit DeleteFile.