Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Función para copiar un fichero origen a un destino y no reemplazar el existente - cambia el nombre - Delphi
Lenguaje de programación Borland Delphi


A esta función de Delphi se le pasa como parámetro un fichero origen (ruta y nombre de fichero) y un fichero destino (ruta y nombre de fichero) y copia el fichero origen en el destino. Si en el destino existe un fichero con el mismo nombre añadirá un número al final del nomber de fichero destino para no reemplazarlo. Esta función devolverá el nombre del fichero destino resultante:

function copiarImagenDespiece (ficheroOrigen, ficheroDestino : string) : string;
var
  i : integer;
begin
  result := '';
  i := 1;
  while FileExists (ficheroDestino) do
  begin
    ficheroDestino := ChangeFileExt(ExtractFileName (ficheroOrigen), '') + 
        IntToStr(i);
    ficheroDestino := IncludeTrailingPathDelimiter(vtRutaDespieces) + 
        ficheroDestino + ExtractFileExt(ficheroOrigen);
    Inc(i);
  end;
  if CopyFile (pchar(ficheroOrigen), pchar (ficheroDestino), true) then
    result := ExtractFileName (ficheroDestino)
  else
    result := '';
end;
Un ejemplo de utilización:
procedure TformAgregarPiezaDespiece.AceptarDespieceClick(Sender: TObject);
var
  nombreFicheroDestino : string;
begin
  if dm.tDespiecesSelPieza.State = dsEdit then
    dm.tDespiecesSelPieza.Post;
  dm.TC3.Close;
  dm.TC3.SQL.Clear;
  dm.TC3.SQL.Add('SELECT Nombre FROM ' + vtTablaDespieces + 
      ' WHERE upper(Nombre) = :pNombre');
  dm.TC3.ParamByName ('pNombre').DataType := ftString;
  dm.TC3.ParamByName ('pNombre').Value := AnsiUpperCase(EditNombre.Text);
  dm.TC3.Open;
  if (EditNombre.Text = '') or (dm.TC3.RecordCount > 0) then
  begin
    MessageDlg ('El nombre intruducido para el despiece no es válido o ya existe.' + 
        #13 + 'Pruebe con otro o pulse [ESC] para cancelar.', 
        mtWarning, [mbok], 0);
    EditNombre.SetFocus;
  end
  else
  begin
    if codigoProveedor = 0 then
    begin
      MessageDlg('Debe seleccionar un proveedor para el despiece.', 
          mtWarning, [mbok], 0);
      Proveedor.SetFocus;
    end
    else
    begin
      with formDespieceImagen do
      begin
        if vtOrigenImagenEscaner then
          nombreFicheroDestino := vtRutaDespieces + EditNombre.Text + 
              ExtractFileExt (EditImagen.Text)
        else
          nombreFicheroDestino := vtRutaDespieces + ExtractFileName (EditImagen.Text);
        nombreFicheroDestino := copiarImagenDespiece (EditImagen.Text, nombreFicheroDestino);
        if nombreFicheroDestino  = '' then
          MessageDlg ('Ha habido un error al copiar la imagen del despiece en la ruta: ' +
              chr(13) + chr(13) + vtRutaDespieces + chr(13) + chr(13) +
              'Compruebe que dicha ruta existe.',
              mtWarning, [mbok], 0)
        else
        begin
          {eliminamos la imagen del despiece si ha sido escaneada}
          if vtEliminarImagenesEscaneadas and vtOrigenImagenEscaner then
            DeleteFile(EditImagen.Text);
          dm.tDespiecesSelPieza.Insert;
          dm.tDespiecesSelPiezaCodigo.Value := generarCodigoAuto(vtTablaDespieces);
          dm.tDespiecesSelPiezaNombre.Value := EditNombre.Text;
          dm.tDespiecesSelPiezaDescripcion.Value := EditDescripcion2.Text;
          dm.tDespiecesSelPiezaCodigoProveedor.Value := codigoProveedor;
          dm.tDespiecesSelPiezaImagen.Value := ExtractFileName (nombreFicheroDestino);
          dm.tDespiecesSelPieza.Post;
          dm.TPieza.Insert;
          dm.TPiezaCodigo.Value := generarCodigoAuto(vtTablaPiezas);
          dm.TPiezaCodigoDespiece.Value := dm.tDespiecesSelPiezaCodigo.Value;
          dm.TPiezaCodigoUsuario.Value := EditCodigo.Text;
          dm.TPiezaDescripcion.Value := EditDescripcion.Text;
          dm.TPiezaPrecioCompra.Value := StrToFloat(EditPrecioCompra.Text);
          dm.TPiezaPrecioVenta.Value := StrToFloat(EditPrecioVenta.Text);
          dm.TPiezaStock.Value := strtofloat(EditStock.Text);
          dm.TPiezaStokMinimo.Value := strtofloat(EditStockMinimo.Text);
          dm.TPiezaCodigoDeBarras.Value := EditCodigoDeBarras.Text;
          dm.TPiezaEstanteria.Value := EditEstanteria.Text;
          dm.TPiezaLeja.Value := EditLeja.Text;
          dm.TPiezaX1.Value := StrToInt(LIzquierda.Caption);
          dm.TPiezaX2.Value := StrToInt(LDerecha.Caption);
          dm.TPiezaY1.Value := StrToInt(LArriba.Caption);
          dm.TPiezaY2.Value := StrToInt(LAbajo.Caption);
          dm.tPiezaCodigoProveedor.Value := codigoProveedor;
          dm.TPieza.Post;
          DBLCBDespieces.KeyValue := dm.tDespiecesSelPiezaCodigo.Value;
          DBLCBDespiecesClick(Sender);
          formAgregarPiezaDespiece.ModalResult := mrOk;
        end;
      end;
    end;
  end;
end;




Publicado el: 2006-02-11

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A