Aplicación Windows y código fuente en Delphi 12 para enviar correos electrónicos y ficheros adjuntos con cuenta de Gmail o de Office 365 (Outlook).
- Requisitos para desarrollar aplicación Windows en Delphi 12.
- Crear aplicación Delphi 12 para Windows con envío de correo electrónico con ficheros adjuntos.
- Enviar Email con Delphi 12 en funcionamiento.
- Descarga del código fuente y el ejecutable de la aplicación Envío Email.
Requisitos para desarrollar aplicación Windows en Delphi 12
Necesitaremos el IDE de desarrollo Delphi 12, que podemos descargar e instalar siguiendo las siguientes instrucciones:
Para el caso de una cuenta de correo en Gmail, necesitaremos activar el doble factor y generar una contraseña de aplicación. Para ello, desde «Seguridad» – «Verificación en dos pasos»:
Pulsaremos en «Contraseñas de aplicación». Si no aparece esta opción en «Verificación en dos pasos», en buscar escribiremos «contraseña de apliación», nos aparecerá la opción «Contraseñas de aplicación»:
Introduciremos un nombre para identificar el uso de esta contraseña, por ejemplo «ProyectoA_EnvioEMail» y pulsaremos en «Crear»:
Se generará una contraseña de 16 caracteres que copiaremos para usarla. Esta será la contraseña que introduzcamos en nuestra aplicación de envío de correos electrónicos:
Hay que tener en cuenta que si cambiamos la contraseña de acceso a nuestra cuenta de Gmail, bien porque caduque o bien porque la hayamos cambiado voluntariamente, deberemos volver a generar una nueva contraseña de aplicación.
Crear aplicación Delphi 12 para Windows con envío de correo electrónico con ficheros adjuntos
Desde Delphi 12, crearemos un nuevo proyecto «Windows VCL Application – Delphi»:
Agregaremos los siguientes componentes al formulario principal de nuestra aplicación:
Añadiremos los siguientes procedimientos para cifrar y descifrar en la unidad del formulario principal:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
const CLACE_CIFRADO = 'MiClaveDecifrado!?3456'; // Clave de cifrado // Función para cifrado básico (no es un método seguro) function TformEnviarEmail.Encriptar(const texto: string): string; var i: Integer; cifrado: string; begin Result := ''; for i := 1 to Length(texto) do cifrado := cifrado + Chr(Ord(texto[i]) + Ord(CLACE_CIFRADO[i mod Length(CLACE_CIFRADO) + 1])); Result := TNetEncoding.Base64.Encode(cifrado); end; // Función para descifrado function TformEnviarEmail.Desencriptar(const texto: string): string; var I: Integer; textoDecodificado, descifrado: string; begin Result := ''; textoDecodificado := TNetEncoding.Base64.Decode(texto); for I := 1 to Length(textoDecodificado) do descifrado := descifrado + Chr(Ord(textoDecodificado[I]) - Ord(CLACE_CIFRADO[I mod Length(CLACE_CIFRADO) + 1])); Result := descifrado end; |
Añadiremos los siguientes procedimientos para guardar en fichero INI y cargar la configuración del fichero INI:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
procedure TformEnviarEmail.CargarConfiguracion; var ficheroINI: TIniFile; begin ficheroINI := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini')); try txtNombreRemitente.Text := ficheroINI.ReadString('Configuracion', 'NombreRemitente', ''); txtEmailRemitente.Text := ficheroINI.ReadString('Configuracion', 'Remitente', ''); txtContrasena.Text := Desencriptar(ficheroINI.ReadString('Configuracion', 'Password', '')); txtEmailDestinatario.Text := ficheroINI.ReadString('Configuracion', 'Destinatario', ''); rgServidor.ItemIndex := ficheroINI.ReadInteger('Configuracion', 'Servidor', 0); opHTML.Checked := ficheroINI.ReadBool('Configuracion', 'FormatoHTML', False); finally ficheroINI.Free; end; end; procedure TformEnviarEmail.GuardarConfiguracion; var ficheroINI: TIniFile; begin ficheroINI := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini')); try ficheroINI.WriteString('Configuracion', 'NombreRemitente', txtNombreRemitente.Text); ficheroINI.WriteString('Configuracion', 'Remitente', txtEmailRemitente.Text); ficheroINI.WriteString('Configuracion', 'Password', trim(Encriptar(txtContrasena.Text))); ficheroINI.WriteString('Configuracion', 'Destinatario', txtEmailDestinatario.Text); ficheroINI.WriteInteger('Configuracion', 'Servidor', rgServidor.ItemIndex); ficheroINI.WriteBool('Configuracion', 'FormatoHTML', opHTML.Checked); finally ficheroINI.Free; end; end; |
Añadiremos los siguientes procedimientos para calcular el tamaño de un fichero adjunto y calcular el tamaño de todos los ficheros adjuntos seleccionados:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
procedure TformEnviarEmail.TamanoTotalAdjuntos; var tamanoTotal: Int64; begin tamanoTotal := CalcularTamanoAdjuntos; if tamanoTotal < 1024 then Label8.Caption := Format('Tamaño total: %d bytes', [tamanoTotal]) else if tamanoTotal < 1024 * 1024 then Label8.Caption := Format('Tamaño total: %0.2f KB', [tamanoTotal / 1024]) else Label8.Caption := Format('Tamaño total: %0.2f MB', [tamanoTotal / (1024 * 1024)]); end; function TformEnviarEmail.CalcularTamanoAdjuntos: Int64; var i: Integer; infoFichero: TSearchRec; begin Result := 0; for i := 0 to lsAdjuntos.Items.Count - 1 do begin if FindFirst(PChar(lsAdjuntos.Items[i].Data), faAnyFile, infoFichero) = 0 then begin Result := Result + infoFichero.Size; FindClose(infoFichero); end; end; end; |
Añadiremos los siguientes procedimientos para agregar adjuntos, quitar un adjunto o quitar todos los adjuntos;
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
procedure TformEnviarEmail.LimpiarAdjuntos; var i: Integer; begin for i := 0 to lsAdjuntos.Items.Count - 1 do StrDispose(PChar(lsAdjuntos.Items[i].Data)); lsAdjuntos.Items.Clear; TamanoTotalAdjuntos; end; procedure TformEnviarEmail.btQuitarTodosAdjuntosClick(Sender: TObject); begin LimpiarAdjuntos; end; procedure TformEnviarEmail.AgregarAdjunto(const AFilePath: string); var itemListView: TListItem; tamanoFichero: Int64; infoFichero: TSearchRec; begin if FindFirst(AFilePath, faAnyFile, infoFichero) = 0 then begin try itemListView := lsAdjuntos.Items.Add; itemListView.Caption := ExtractFileName(AFilePath); tamanoFichero := infoFichero.Size; if tamanoFichero < 1024 then itemListView.SubItems.Add(Format('%d bytes', [tamanoFichero])) else if tamanoFichero < 1024 * 1024 then itemListView.SubItems.Add(Format('%0.2f KB', [tamanoFichero / 1024])) else itemListView.SubItems.Add(Format('%0.2f MB', [tamanoFichero / (1024 * 1024)])); itemListView.Data := Pointer(StrNew(PChar(AFilePath))); TamanoTotalAdjuntos; finally FindClose(infoFichero); end; end; end; |
Para el botón de mostrar la contraseña («M»), añadiremos el siguiente código Delphi/Pascal:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
procedure TformEnviarEmail.btMostrarContrasenaClick(Sender: TObject); begin if txtContrasena.PasswordChar = '*' then begin txtContrasena.PasswordChar := #0; btMostrarContrasena.Caption := 'O'; end else begin txtContrasena.PasswordChar := '*'; btMostrarContrasena.Caption := 'M'; end; end; |
Para el botón «Adjuntar», añadiremos el siguiente código Delphi/Pascal:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
procedure TformEnviarEmail.btAdjuntarArchivoClick(Sender: TObject); var i: Integer; begin if dlFichero.Execute then begin for i := 0 to dlFichero.Files.Count - 1 do begin AgregarAdjunto(dlFichero.Files[i]); end; end; end; |
Para el botón «Quitar» añadiremos el siguiente código Delphi/Pascal:
|
1 2 3 4 5 6 7 8 9 |
procedure TformEnviarEmail.btQuitarAdjuntoClick(Sender: TObject); begin if Assigned(lsAdjuntos.Selected) then begin StrDispose(PChar(lsAdjuntos.Selected.Data)); lsAdjuntos.Selected.Delete; TamanoTotalAdjuntos; end; end; |
Para el botón «Quitar todos» añadiremos el siguiente código Delphi/Pascal:
|
1 2 3 4 |
procedure TformEnviarEmail.btQuitarTodosAdjuntosClick(Sender: TObject); begin LimpiarAdjuntos; end; |
Para el botón «Enviar Correo» añadiremos el siguiente código Delphi/Pascal:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
procedure TformEnviarEmail.btEnviarEmailClick(Sender: TObject); var SMTP: TIdSMTP; Email: TIdMessage; SSLHandler: TIdSSLIOHandlerSocketOpenSSL; servidorSMTP: string; puertoSMTP: Integer; i: Integer; cuerpoMensaje: TIdText; begin // Configurar servidor SMTP según selección if rgServidor.ItemIndex = 0 then // Gmail begin servidorSMTP := 'smtp.gmail.com'; puertoSMTP := 587; end else // Outlook begin servidorSMTP := 'smtp.office365.com'; puertoSMTP := 587; end; // Validar campos obligatorios if Trim(txtEmailRemitente.Text) = '' then begin MessageDlg('Introduce el correo electrónico del remitente.', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0); Exit; end; if Trim(txtContrasena.Text) = '' then begin MessageDlg('Introduce la contraseña del correo electrónico del remitente.', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0); Exit; end; if Trim(txtEmailDestinatario.Text) = '' then begin MessageDlg('Introduce al menos un destinatario (o varios separados por punto y coma).', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0); Exit; end; if Trim(txtAsunto.Text) = '' then begin MessageDlg('Introduce el asunto del correo electrónico.', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0); Exit; end; // Validar tamaño de adjuntos (no debe superar los 25MB) if CalcularTamanoAdjuntos > 25 * 1024 * 1024 then begin MessageDlg('El tamaño total de los adjuntos supera los ' + '25MB. Comprima los ficheros adjuntos, reduzca su tamaño ' + 'o envíelos en varios emails.', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0); Exit; end; // Crear componentes para conexión con servidor y creación de email SMTP := TIdSMTP.Create(nil); Email := TIdMessage.Create(nil); SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil); try // Configurar conexión SSL con servidor de correo electrónico if not IdSSLOpenSSLHeaders.Load then raise Exception.Create('No se pudo cargar OpenSSL. Asegúrate que los ' + 'ficheros libssl-1_1-x64.dll y libcrypto-1_1-x64.dll están ' + 'en la carpeta de la aplicación.'); SSLHandler.SSLOptions.Method := sslvTLSv1_2; SSLHandler.SSLOptions.Mode := sslmClient; // Configurar SMTP con autenticación básica (no OAuth) SMTP.IOHandler := SSLHandler; SMTP.Host := servidorSMTP; SMTP.Port := puertoSMTP; SMTP.Username := txtEmailRemitente.Text; SMTP.Password := txtContrasena.Text; SMTP.UseTLS := utUseExplicitTLS; SMTP.AuthType := satDefault; // Configurar mensaje Email.From.Name := txtNombreRemitente.Text; Email.From.Address := txtEmailRemitente.Text; Email.Recipients.EmailAddresses := txtEmailDestinatario.Text; Email.Subject := txtAsunto.Text; //Estructura principal del mensaje (SIEMPRE multipart/mixed para adjuntos) Email.ContentType := 'multipart/mixed'; // Obligatorio para adjuntos // Cuerpo del mensaje (texto plano O HTML, según opción del usuario) cuerpoMensaje := TIdText.Create(Email.MessageParts, nil); // Se agrega al mensaje principal // Configurar cuerpo del mensaje (HTML o texto plano) if opHTML.Checked then begin cuerpoMensaje.ContentType := 'text/html; charset=utf-8'; cuerpoMensaje.Body.Text := txtMensaje.Lines.Text; //CuerpoMensaje.CharSet := 'utf-8'; end else begin cuerpoMensaje.ContentType := 'text/plain; charset=utf-8'; cuerpoMensaje.Body.Text := txtMensaje.Lines.Text; end; // Agregar adjuntos for i := 0 to lsAdjuntos.Items.Count - 1 do begin TIdAttachmentFile.Create(Email.MessageParts, PChar(lsAdjuntos.Items[i].Data)); end; // Enviar correo try SMTP.Connect; try SMTP.Send(Email); MessageDlg('Correo electrónico enviado correctamente a ' + txtEmailDestinatario.Text + '.', TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], 0); finally SMTP.Disconnect; end; except on E: Exception do MessageDlg('Error al enviar correo electrónico: ' + chr(13) + chr(13) + E.Message, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0); end; finally SMTP.Free; Email.Free; SSLHandler.Free; end; end; |
En los Uses del formulario, añadiremos los siguientes:
|
1 2 3 4 5 6 7 |
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, IdSMTP, IdSSLOpenSSL, IdMessage, IdText, IdAttachmentFile, IdExplicitTLSClientServerBase, IdIOHandler, IdIOHandlerStack, IdSSL, IdSSLOpenSSLHeaders, IdGlobal, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IniFiles, Vcl.ExtCtrls, System.NetEncoding; |
En el siguiente enlace dejamos la descarga del código fuente completo de la aplicación en Delphi 12:
Enviar Email con Delphi 12 en funcionamiento
Introduciremos los datos para el envío del correo electrónico:
- Nombre: nombre que aparecerá como remitente (como emisor, el que envía).
- Remitente: correo electrónico del emisor (el que envía).
- Contraseña: la contraseña de aplicación generada para la cuenta del remitente, como explicamos en este punto del tutorial.
- Destinatario: correo electrónico del destinatario del mensaje.
- Asunto.
- Mensaje: en formato de texto plano si no marcamos la opción «HTML». Si marcamos «HTML» podemos usar formato HTML en mensaje. Por ejemplo, para poner un texto en negrita, usaremos <b></b>.
- Adjuntos: agregaremos los ficheros adjuntos que queramos enviar al destinatario.
Una vez introducidos los datos, pulsaremos en «Enviar Correo»:
Si los datos del remitente son correctos (usuario y contraseña), el correo electrónico se enviará, indicándolo con un mensaje. Si se produce algún error, también nos lo indicará.
El correo electrónico habrá llegado al destinatario con los ficheros adjuntos añadidos y en formato HTML:
Descarga del código fuente y el ejecutable de la aplicación Envío Email
En el siguiente enlace dejamos la descarga del código fuente en Delphi 12 de la aplicación de envío de correo electrónico con ficheros adjuntos desde GMail o desde Office 365. La descarga incluye el fichero ejecutable de la aplicación para entornos de 32 y 64 bits, también incluye los ficheros DLL necesarios de OpenSSL:
