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