Asignar path para guardar imágenes

[radenf]

Muchas gracias por tu respuesta TOPX , pero no lo puedo hacer porque mi OpenDialog1 es un SelectDirectoryDialog, de los bsSkinForms, para abrir directorios completos y no posee esa propiedad.
Salu2

[ecfisa]

¿Es posible evitar el mensaje que genera Windows señalando que la carpeta no existe y preguntando si deseo crearla, cada vez que utilizo dicho código?

Hola radenf.

Supongo que así tendría que funcionarte:

Código Delphi [-]
...
uses ShellApi;

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_SILENT;
    fAnyOperationsAborted := Aborted;
  end;
  try
    SHFileOperation(SHFileOpStruct);
  except
    raise Exception.Create('Error copiando la carpeta');
  end;
end;

Llamada:

Código Delphi [-]
var
  Origen, Destino: string;
begin
  ...
  Destino:= MakePath(Edit2, Date,(Edit4.Text));
  Origen := ExcludeTrailingPathDelimiter(Directory(OpenDialog1.Directory));
  SHFileCopy(Handle, Origen, Destino);
  ...
end;

No conozco el componente SelectDirectoryDialog y no puedo probar si devuelve un valor finalizado con delimitador. Tal vez sea innecesario el uso de la funcion ExcludeTrailingPathDelimiter.

Saludos.

Edito: Hay un error en esta línea:

Código Delphi [-]
Origen := ExcludeTrailingPathDelimiter(Directory(OpenDialog1.Directory));

Era:

Código Delphi [-]
Origen := ExcludeTrailingPathDelimiter(ExtractFilePath(OpenDialog1.FileName));

Disculpas

[radenf]

Muchas gracias ecfisa , pero el código no funciona con este componente.
No acepta Directory como string en (Directory(OpenDialog1.Directory)
Seguiré probando y les cuento.
Saludos

[radenf]

Muchas gracias de nuevo ecfisa, 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.
Saludos

[ecfisa]

Hola radenf.

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); // (Invierto fecha para mantener órden en nombres de carpeta)
  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.

[radenf]

Muchas gracias Daniel por tu paciencia, dedicación y desinterés.
El código funciona perfecto. Hace lo que debe, sin embargo me encontré con una situación que no había considerado y que es cuando un Estudio contiene varias Series, que es lo habitual, en estos casos se crea la carpeta de los estudios y de la primera serie, sin cargar las imágenes ni el resto de las series.

La ruta debiera ser:

Aplicacion\Dicom Data\Archivos Dicom\Estudio\Serie1\Imagenes
\Serie2\Imagenes
\Serie3\Imagenes
\ etc.

Las imágenes pueden ser 1 o miles y se guardan en formto .dcm

¿Es posible arreglarlo?
Saludos y nuevamente gracias

[ecfisa]

Hola Iván.

Te consulto sobre algunos puntos que no me quedaron claros:

• ¿ La fecha ya no estaría en la composición de la ruta ?
• ¿ Si la fecha sigue estando en qué nivel de la ruta se ubica ?
• ¿ La carpeta Estudio es un nombre constante o en su lugar iría el número de estudio/inclusión ?

Estaría buenísimo si pudieses poner un prototipo de como deseas que se arme la ruta completa.

Saludos.