Hola radenf.
Cita:
|
pero con el nuevo código por alguna extraña razón me copia todas las subcarpetas del directorio, no importando cúal haya yo seleccionado.
|
En realidad no es extraño, copiar las subcarpetas es el comportamiento normal de la función
SHFileOperation con el flag que le asigne. Fuí yo quién interpreté mal lo que deseabas.
Como te mencioné, no tengo forma de probar con el componente
SelectDirectoryDialog, pero usando un
TDirectoryListBox para seleccionar el orígen y de este modo funciona correctamente:
Código Delphi
[-]
uses ShellApi;
function MakePath(const Cad: string; const aDate: TDate): string;
begin
Result := Copy(DateToStr(aDate),7,4) + '-' +
Copy(DateToStr(aDate),4,2) + '-' +
Copy(DateToStr(aDate),1,2); Result := ExtractFilePath(Application.ExeName)+'Dicom Data\Archivos Dicom\'+
Result + '\' + Cad + '\';
end;
procedure SHFileCopy(hWndOwner: HWND; const SourceFile, TargetFile: string);
var
SHFileOpStruct: TSHFileOpStruct;
Aborted : Bool;
begin
Aborted := False;
with SHFileOpStruct do
begin
Wnd := hWndOwner;
wFunc := FO_COPY;
pFrom := PChar(SourceFile);
pTo := PChar(TargetFile);
fFlags := FOF_NOCONFIRMMKDIR + FOF_FILESONLY + FOF_SILENT;
fAnyOperationsAborted := Aborted;
end;
try
SHFileOperation(SHFileOpStruct);
except
raise Exception.Create('Error copiando la carpeta');
end;
end;
procedure TForm1.btnCopiarClick(Sender: TObject);
var
Origen, Destino: string;
begin
Origen := DirectoryListBox1.Directory;
Destino:= MakePath(Edit1.Text, Date)+
ExtractFileName(ExcludeTrailingPathDelimiter(Origen));
CreateDirectory(PChar(Destino),0);
if GetLastError <> ERROR_ALREADY_EXISTS then
SHFileCopy(Handle, Origen + '\*.*', Destino)
else
raise Exception.Create('Directorio existente');
end;
Quité el parámetro
aName de la función
MakePath ya que creo entender que todos los archivos deben ser copiados. La carpeta se crea previamente a la copia mediante la función
CreateDirectory, y agregué el flag
FOF_FILESONLY que copia sólo archivos usando el comodín ('*.*') como nombre de archivo.
Ahora queda probarlo con el
SelectDirectoryDialog...
Saludos.
