Subir Documento

[zuritavic]

yo utilizo este codigo para subir documentos ftp en delphi xe7

procedure TfrmFacturaPorPargarTotal.btSubirFTPClick(Sender: TObject);
var
   archivoSubir,
   documento,
   extension,
   Nombre_Virtual  :string;
   Id_Doc2 : integer;
   resultado : STRING;
   respuesta : integer;


begin



   if    qrDocumentos.fieldbyname('Documento').asstring <> '' then
      begin
          respuesta :=  MessageDlg('Desea sobre escribir el documento?'+qrDocumentos.fieldbyname('Documento').asstring,    mtConfirmation, [mbYes, mbNo],0);

          if respuesta = mrNo  then
          begin
              exit;
          end;

       end;
   savedialog1.DefaultExt := '*.'+qrDocumentos.fieldbyname('Tipo_Documento').value;
   savedialog1.FileName :=  '*.'+qrDocumentos.fieldbyname('Tipo_Documento').value;

   if savedialog1.Execute then
      begin
           if dm.ftpParametros then

           begin

              documento:= extractFilename(SaveDialog1.FileName);
              extension := ExtractFileExt( SaveDialog1.FileName) ;
              archivoSubir   :=  SaveDialog1.FileName ;
             dm.DevuelveNombre.Prepared := true;
             dm.DevuelveNombre.ExecProc;
             Nombre_Virtual:= dm.DevuelveNombre.Parameters.ParamByName('@nomVirtual').value;
             Nombre_Virtual := Nombre_Virtual+ extension;



             subirFTP(archivoSubir,Nombre_Virtual,'embarquepro.com'//--dm.FTP_URL
             ,'',dm.FTP_USERNAME,dm.FTP_PASSWORD ,strToint(dm.FTP_PUERTO),resultado);
              if resultado = 'OK' then
                  begin

                      dm.spInsDoc.Prepared := true;

                      dm.spInsDoc.Parameters.ParamByName('@Documento').value := documento;
                      dm.spInsDoc.Parameters.ParamByName('@Nombre_Virtual').value := Nombre_virtual;
                      dm.spInsDoc.Parameters.ParamByName('@F_Recibido').value := now;
                      dm.spInsDoc.Parameters.ParamByName('@Creado_por').value := id_usuario;

                      dm.spInsDoc.ExecProc;
                      Id_Doc2 := dm.spInsDoc.Parameters.ParamByName('@Id_Doc2').value;
                      //dm.spInsDoc.Parameters.ParamByName('@VValor_Mensaje int out,
                      // dm.spInsDoc.Parameters.ParamByName('@VMensaje varchar(200) out


                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Prepared := true;
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@Id').value := qrDocumentos.fieldbyname('Id').value;
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@Id_Documento').value := Id_Doc2;
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@Comentario').value := 'Cargado desde version windows';
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@contador').value := 1;

                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.ExecProc;
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@VValor_Mensaje').value;
                      dm.spUp_Fm_Facturas_Por_Pagar_Doc.Parameters.ParamByName('@VMensaje').value;

                  end
              else
                  begin
                     showmessage('erro en el FTP');
                  end ;
               qrDocumentos.Close;
               qrDocumentos.open;


           end;

      end;



end;