Después de mucho tiempo de no publicar nada, el día de hoy publico la nueva versión del procedimiento de envío de correos con adjuntos utilizando UTL_SMTP.
He de agradecer a todos los que han realizado comentarios sobre dudas, errores y ajustes que han sido necesarios realizar al programa.
Los cambios son menores (de hecho van comentados en un pequeño encabezado) y con se han realizado correcciones a algunos errores detectados.
Espero a partir de hoy, poder realizar publicaciones con mayor regularidad para seguir compartiendo y aprendiendo de mis lectores.
Les dejo el código, para ejecutarlo se utiliza la misma sentencia que está en el post Envío de Correos utilizando UTL_SMTP
-- Envio de Correos a multiples destinatarios con multiples adjuntos utilizando UTL_SMTP
PROCEDURE P_SendMailAttach(p_DestinatariosPara IN VARCHAR2 CHARACTER SET ANY_CS,
p_DestinatariosCC IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL,
p_DestinatariosBcc IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL,
p_Mensaje IN LONG DEFAULT 'Haga caso omiso a este mensaje',
p_Remitente IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT 'correo@dominio.com',
p_Asunto IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT 'Este correo no tiene asunto',
p_TipoMensaje IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT 'TEXT',
p_Directorio IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT 'ATTACHMENTS',
p_ArchivosAdjuntos IN VARCHAR2 CHARACTER SET ANY_CS)
AS
-----------------------------------------------------------------------------------------------
-- Programa : P_SendMailAttach
-- Descripción : Procedimiento para el envío de correos planos y HTML con adjuntos
-- utilizando el package UTL_SMTP.
-- Notas : Los listados de remitentes deberán contener las direcciones separadas por un
-- colon (,)
-- El mensaje por default esta definido como texto plano
-- El Cuerpo del Mensaje no debe superar los 32K (Resolved)
-- When Who What
-- =========== ====================== =================================================
-- 21-MAR-2012 Rogelio Rodríguez Initial Creation
--
-- 16-APR-2012 Rogelio Rodríguez Se agrega la clausula CHARACTER SET ANY_CS para
-- permitir el uso de caracteres especiales en los
-- valores de tipo VARCHAR2 de manera automática
-- 16-APR-2012 Rogelio Rodríguez Se modifican las rutinas para la separación de
-- Items, cambiando el reemplaxo de espacios en
-- blanco por un TRIM y un replace '; ' que es lo
-- más común
--
-- 20-JUN-2012 Rogelio Rodriguez Se modifica el envío del mensaje y asunto, utili-
-- zando la conversión a RAW para que respete el
-- juego de caracteres iso-8859-1 en los procedi-
-- mientos SendMail y SendMailAttach.
--
-- 15-OCT-2012 Rogelio Rodríguez Se modifica la variable p_Mensaje de VARCHAR2
-- a LONG para que no tenga el límite de los 32K.
--
-- 08-OCT-2014 Rogelio Rodríguez Se modifica el orden de inserción de encabezados
-- y límites para la separación de adjuntos ya que
-- bajo el servidor SMTP Exchange 2010 no se
-- realizaba de manera correcta la adición de
-- Adjuntos en el procedimiento SendMailAttach.
-----------------------------------------------------------------------------------------------
c utl_smtp.connection;
l_ServidorSMTP VARCHAR2(30);
l_PuertoSMTP VARCHAR2(10);
l_MensajeRaw LONG RAW;
--Procedimiento para escritura de Headers
-----------------------------------------------------------------
PROCEDURE send_header(name IN VARCHAR2, header IN VARCHAR2) AS
BEGIN
utl_smtp.write_data(c, name || ': ' || header || utl_tcp.CRLF);
END;
-----------------------------------------------------------------
--Procedimiento para Adición de Destinatarios
-----------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_rcpt(p_Destinatarios in VARCHAR2) AS
l_Cadena varchar2(500) := p_Destinatarios;
l_LargoCadena number;
l_Comas number;
l_PosicionComa number := 0;
l_Destinatario varchar2(100);
BEGIN
l_Cadena := replace(l_Cadena,', ',',');
l_Cadena := trim(l_Cadena);
l_LargoCadena := length(l_Cadena);
l_Comas := l_LargoCadena-length(replace(l_Cadena,','));
--Bloque 1 Asginación del RCPT
IF l_Comas > 0 THEN
FOR l_segmento IN 1 .. l_Comas LOOP
l_Destinatario := substr(l_Cadena, l_PosicionComa + 1, instr(l_Cadena,',',1,l_segmento) - (l_PosicionComa + 1));
l_PosicionComa := instr(l_Cadena,',',1,l_Segmento);
utl_smtp.rcpt(c, l_Destinatario);
END LOOP;
END IF;
-- Fin de Bloque 1
-- Bloque 2: Para inserción del ultimo recipient solicitado (o el primero, si es unico)
l_Destinatario := substr(l_Cadena, l_PosicionComa + 1, l_LargoCadena);
utl_smtp.rcpt(c, l_Destinatario);
-- Fin Bloque 2
END;
---------------------------------------------------------------------------------------------------------------------------------
-- Procedimiento de adición de cabeceras para destinatarios
---------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_headers_rcpt(p_Destinatarios IN VARCHAR2, p_Type IN VARCHAR2) AS
l_Cadena varchar2(500) := p_Destinatarios;
l_LargoCadena number;
l_Comas number;
l_PosicionComa number := 0;
l_Destinatario varchar2(100);
BEGIN
l_Cadena := replace(l_Cadena,', ',',');
l_Cadena := trim(l_Cadena);
l_LargoCadena := length(l_Cadena);
l_Comas := l_LargoCadena-length(replace(l_Cadena,','));
--Bloque 1 Asginación del Destinatario al header
IF l_Comas > 0 THEN
FOR l_segmento IN 1 .. l_Comas LOOP
l_Destinatario := substr(l_Cadena, l_PosicionComa + 1, instr(l_Cadena,',',1,l_segmento) - (l_PosicionComa + 1));
l_PosicionComa := instr(l_Cadena,',',1,l_Segmento);
-- Se generan los encabezados para envio, en caso de Bcc no se agrega el Header
IF p_Type = 'TO' THEN
send_header('To', l_Destinatario);
ELSE
send_header('Cc', l_Destinatario);
END IF;
END LOOP;
END IF;
-- Fin de Bloque 1
-- Bloque 2: Para inserción del ultimo recipient solicitado (o el primero, si es unico)
l_Destinatario := substr(l_Cadena, l_PosicionComa + 1, l_LargoCadena);
IF p_Type = 'TO' THEN
send_header('To', l_Destinatario);
ELSE
send_header('Cc', l_Destinatario);
END IF;
-- Fin Bloque 2
END;
----------------------------------------------------------------------------------------------------------------------------------------------
-- Procedimiento para adjuntar los archivos al stream del correo
---------------------------------------------------------------------------------------------------------------------
PROCEDURE file_attach(p_Archivo varchar2) AS
-- Variables para el procesamiento de Archivos
rfile RAW(57);
flen NUMBER;
bsize NUMBER;
src_file bfile;
buffer_ integer := 57;
i integer := 1;
BEGIN
-- Escribir cabecera MIME
utl_smtp.write_data(c,'--MIME.Bound'||utl_tcp.CRLF);
send_header('Content-Type','application/octet-stream; name="' || p_Archivo || '"');
send_header('Content-Transfer-Encoding', 'base64' );
send_header('Content-Disposition', 'attachment; filename="' || p_Archivo || '"');
utl_smtp.write_data(c, utl_tcp.CRLF);
-- Adición del Archivo
src_file := bfilename(p_Directorio, p_Archivo);
flen := dbms_lob.getlength(src_file);
dbms_lob.fileopen(src_file, dbms_lob.file_readonly);
while i < flen loop
dbms_lob.read( src_file, buffer_, i, rfile );
utl_smtp.write_raw_data(c, utl_encode.base64_encode(rfile));
utl_smtp.write_data(c, utl_tcp.CRLF);
i := i + buffer_;
end loop while_loop;
dbms_lob.fileclose(src_file);
utl_smtp.write_data(c, utl_tcp.CRLF||utl_tcp.CRLF);
END;
------------------------------------------------------------------------------------------------------------------------------------
--Procedimiento para separación y Adición de Archivos Adjuntos
------------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_attachments(p_Adjuntos in VARCHAR2) AS
l_Cadena varchar2(500) := p_Adjuntos;
l_LargoCadena number;
l_Comas number;
l_PosicionComa number := 0;
l_Archivo varchar2(100);
-- Variables para el procesamiento de Archivos
rfile RAW(57);
flen NUMBER;
bsize NUMBER;
src_file bfile;
buffer_ integer := 57;
i integer := 1;
BEGIN
l_Cadena := replace(l_Cadena,', ',',');
l_Cadena := trim(l_Cadena);
l_LargoCadena := length(l_Cadena);
l_Comas := l_LargoCadena-length(replace(l_Cadena,','));
--Bloque 1 Adición del Archivo
IF l_Comas > 0 THEN
FOR l_segmento IN 1 .. l_Comas LOOP
l_Archivo := substr(l_Cadena, l_PosicionComa + 1, instr(l_Cadena,',',1,l_segmento) - (l_PosicionComa + 1));
dbms_output.put_line(l_Archivo);
file_attach(l_Archivo);
l_PosicionComa := instr(l_Cadena,',',1,l_Segmento);
END LOOP;
END IF;
-- Fin de Bloque 1
-- Bloque 2: Para inserción del ultimo archivo (o el primero, si es unico)
l_Archivo := substr(l_Cadena, l_PosicionComa + 1, l_LargoCadena);
file_attach(l_Archivo);
-- Fin Bloque 2
END;
---------------------------------------------------------------------------------------------------------------------------------
-- Inicio del Programa Core para el correo
BEGIN
-- Bloque de Apertura de Conexión
l_ServidorSMTP := F_RetornaValorParametro('LOCAL_SERVER_MAIL');
l_PuertoSMTP := F_RetornaValorParametro('LOCAL_SERVER_MAIL_PORT');
c := utl_smtp.open_connection(l_ServidorSMTP,l_PuertoSMTP);
utl_smtp.helo(c, l_ServidorSMTP);
utl_smtp.mail(c, p_Remitente);-- Remitente
-- Bloque de Adición de Destinatarios
IF p_DestinatariosPara IS NOT NULL THEN
add_rcpt(p_DestinatariosPara);
END IF;
IF p_DestinatariosCC IS NOT NULL THEN
add_rcpt(p_DestinatariosCC);
END IF;
IF p_DestinatariosBcc IS NOT NULL THEN
add_rcpt(p_DestinatariosBcc);
END IF;
--Bloque de Apertura de Datos
utl_smtp.open_data(c);
-- Bloque de Adición de Cabeceras de Mail
IF p_DestinatariosPara IS NOT NULL THEN
add_headers_rcpt(p_DestinatariosPara, 'TO');
END IF;
IF p_DestinatariosCC IS NOT NULL THEN
add_headers_rcpt(p_DestinatariosCC, 'CC');
END IF;
-- Demás Cabeceras
send_header('From', p_Remitente); -- De
send_header('MIME-Version','1.0');
send_header('Content-Type','multipart/mixed; boundary="MIME.Bound"');
-- Escritura del Asunto
l_MensajeRaw := utl_raw.cast_to_raw('Subject:'||p_Asunto);
utl_smtp.write_raw_data(c, l_MensajeRaw);
utl_smtp.write_data(c, utl_tcp.CRLF);
-- Inicia bloques de escritura de Mensaje y Archivos con sus respectivos Boundaries
utl_smtp.write_data(c,'--MIME.Bound'||utl_tcp.CRLF);
IF p_Mensaje IS NOT NULL THEN
IF p_TipoMensaje = 'TEXT' THEN
send_header('MIME-Version','1.0');
send_header('Content-Type','text/plain; charset=iso-8859-1');
send_header('Content-Disposition', 'inline');
ELSE
send_header('MIME-Version','1.0');
send_header('Content-Type', 'text/html;charset=iso-8859-1');
send_header('Content-Disposition', 'inline');
send_header('Content-Transfer-Encoding', '8bit');
END IF;
END IF;
-- Bloque de Escritura del Mensaje
l_MensajeRaw := utl_raw.cast_to_raw(p_Mensaje);
utl_smtp.write_data(c, utl_tcp.CRLF);
utl_smtp.write_raw_data(c, l_MensajeRaw);
utl_smtp.write_data(c, utl_tcp.CRLF);
utl_smtp.write_data(c, utl_tcp.CRLF);
-- Bloque de Envio de Adjuntos
add_attachments(p_ArchivosAdjuntos);
utl_smtp.write_data(c, utl_tcp.CRLF||'--MIME.Bound'||utl_tcp.CRLF);
-- Bloque de Cierre de Datos y Envio del Mail
utl_smtp.close_data(c);
-- Bloque de Cierre de Conexión
utl_smtp.quit(c);
EXCEPTION
WHEN utl_smtp.Transient_Error OR utl_smtp.Permanent_Error then
-- Bloque de Cierre de Conexión
utl_smtp.quit(c);
raise_application_error(-20100, 'Unable to send mail: '||sqlerrm);
WHEN OTHERS THEN
-- Bloque de Cierre de Conexión
utl_smtp.quit(c);
raise_application_error(-20100, 'Unable to send mail: '||sqlerrm);
END P_SendMailAttach;
Espero nuevamente les sea de utilidad el código, me llevo de tarea una mejor implementación del mismo de forma tal que las funciones y procedimientos internos puedan ser reutilizables.
Así mismo espero sus comentarios sobre funcionamiento u otras mejoras a agregar.
