Regresando a mi blog, el día de hoy publico la versión 2 del envío de correo electrónico utilizando UTL_SMTP.
Como nueva caracteristica, he de comentar, tiene la capacidad de soportar SMTP autenticado.
Espero les sea de utilidad.
create or replace PROCEDURE P_EnviaCorreoUtlSmtp(p_servidor IN VARCHAR2 CHARACTER SET ANY_CS,
p_puerto IN NUMBER,
p_usuario IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL,
p_contrasena IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL,
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,
p_Remitente IN VARCHAR2 CHARACTER SET ANY_CS,
p_Asunto IN VARCHAR2 CHARACTER SET ANY_CS,
p_TipoMensaje IN VARCHAR2 CHARACTER SET ANY_CS,
p_Directorio IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL,
p_ArchivosAdjuntos IN VARCHAR2 CHARACTER SET ANY_CS DEFAULT NULL)
AS
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_RAW.cast_to_varchar2(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(1000) := 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);
dbms_output.put_line(l_Archivo);
file_attach(l_Archivo);
-- Fin Bloque 2
END;
---------------------------------------------------------------------------------------------------------------------------------
-- Inicio del Programa Core para el correo
BEGIN
-- Bloque de Apertura de Conexión
l_ServidorSMTP := p_servidor;
l_PuertoSMTP := p_puerto;
c := utl_smtp.open_connection(l_ServidorSMTP,l_PuertoSMTP);
utl_smtp.helo(c, l_ServidorSMTP);
IF p_usuario IS NOT NULL THEN
utl_smtp.command(c, 'AUTH LOGIN');
utl_smtp.command(c,utl_raw.cast_to_varchar2(utl_encode.base64_encode(utl_raw.cast_to_raw(p_usuario))));
utl_smtp.command(c,utl_raw.cast_to_varchar2(utl_encode.base64_encode(utl_raw.cast_to_raw(p_contrasena))));
END IF;
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('Reply-To', p_Remitente); -- Responder a
-- 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);
send_header('MIME-Version','1.0');
send_header('Content-Type','multipart/mixed; boundary="MIME.Bound"'||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);
-- MIME Header según el tipo de mensaje
IF p_Mensaje IS NOT NULL THEN
IF p_TipoMensaje = 'TEXT' THEN
send_header('Content-Type','text/plain; charset="iso-8859-1"'||utl_tcp.CRLF);
ELSE
send_header('Content-Type', 'text/html;charset="iso-8859-1"'||utl_tcp.CRLF);
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
IF p_ArchivosAdjuntos IS NOT NULL THEN
add_attachments(p_ArchivosAdjuntos);
END IF;
-- 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 OTHERS THEN
-- Bloque de Cierre de Conexión
utl_smtp.quit(c);
raise_application_error(-20100, 'Unable to send mail: '||sqlerrm);
END P_EnviaCorreoUtlSmtp;
De antemano, gracias por leer este blog.
Saludos Wazu!
