SHFileOperation löst Exception aus ?!

[Olli]

So, habe es mir angeguckt und mit dem Lesen der Doku scheinst du's ja nicht gerade zu halten

Du kannst mir sicher beispielsweise plausibel machen, wieso du SHFreeNameMappings() verwendest?!

Und wie du Typen (DWORD und Integer zB) und Bedeutungen durcheinanderwürfelst ist eine wahre Freude. So benutzt du Integer als Rückgabetyp, weist aber einen GetLastError()-Wert zu, wobei dieser DWORD ist - bei nichtvorhandenem Verzeichnis wird's -1. Putzigerweise weist du dem gleichen Rückgabewert auch noch das Ergebnis von SHFileOperation() zu, obwohl dort eindeutig steht, daß 0 bedeutet erfolgreich (entspricht GetLastError) und alles andere bedeutet nicht erfolgreich. Dort steht aber nirgends, daß der Rückgabewert ein Fehlercode ist!

Probiere mal, ob folgendes funktioniert.

Delphi-Quellcode:

function CopyDir(DirFrom, DirTo, ProgessTitle: string; Flags: Integer = 0; bErrorHandler: Boolean = True): DWORD;
var
  shellinfo: TSHFileOpStruct;
begin
  // Bail out if the target directory does not exist
  if not DirectoryExists(DirTo) then
  begin
    Result := ERROR_PATH_NOT_FOUND;
    Exit;
  end;

  // Initialize structure
  ZeroMemory(@shellinfo, sizeof(shellinfo));
  // Finalize the strings to be appropriately terminated
  DirFrom := DirFrom + #0#0;
  DirTo := DirTo + #0#0;

  with shellinfo do
  begin
    Wnd := GetDesktopWindow();
    wFunc := FO_COPY; // Copy action
    pFrom := @DirFrom[1]; // Source file(s)/directories
    pTo := @DirTo[1]; // Target directory
    fFlags := FOF_SIMPLEPROGRESS or FOF_NOCONFIRMATION or Flags;
    Flags := fFlags; // For cleaner code
    lpszProgressTitle := @ProgessTitle[1];
  end;

  try
    while ((SHFileOperation(shellinfo) <> NO_ERROR) and (bErrorHandler)) do
    begin
      if MessageDlg(Format('Das Verzeichnis'#13#10#13#10
        + '''%s'''#13#10#13#10
        + 'kann nicht nach'#13#10#13#10
        + '''%s'''#13#10#13#10
        + 'kopiert werden.'#13#10#13#10
        + 'Grund: %s'#13#10#13#10
        + 'Soll der Vorgang erneut versucht werden ?'#13#10#13#10
        + 'Wenn Sie ''Abbrechen'' drücken, muss das Verzeichnis'#13#10
        + 'oder die Dateien manuell kopiert werden !',
        [PChar(DirFrom), PChar(DirTo), GetFormatErrorMessage(GetLastError())]),
        mtWarning, [mbAbort, mbRetry], -1) <> mrRetry then
        break;
    end;
  finally
    if (Flags and FOF_WANTMAPPINGHANDLE <> 0) then
      SHFreeNameMappings(THandle(shellinfo.hNameMappings));
    Result := GetLastError();
  end;
end;

PS: Sorry, hat etwas länger gedauert wegen Mittagbrot

Nachtrag: Fehlerchen im formatierten String korrigiert ...