CREATE OR REPLACE PROCEDURE PROC_ENVIAR_EMAIL_ATTACHMENT (
p_servidor IN VARCHAR2 CHARACTER SET ANY_CS,
p_Remitente IN VARCHAR2 CHARACTER SET ANY_CS,
p_DestinatariosPara IN VARCHAR2 CHARACTER SET ANY_CS,
p_DestinatariosCC IN VARCHAR2 CHARACTER SET ANY_CS,
p_DestinatariosBcc IN VARCHAR2 CHARACTER SET ANY_CS,
p_Asunto IN VARCHAR2 CHARACTER SET ANY_CS,
p_Mensaje IN LONG,
p_ArchivosAdjuntos IN VARCHAR2 CHARACTER SET ANY_CS,
p_codigoError IN OUT VARCHAR2,
p_mensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT VARCHAR2
)
AS
/******************************************************************************************************************************/
/*Procedimiento que se encarga de enviar correos con adjuntos desde la base de datos atravez de UTL_SMTP */
/******************************************************************************************************************************/
c UTL_SMTP.connection;
l_ServidorSMTP VARCHAR2 (1000) := p_servidor;
l_PuertoSMTP VARCHAR2 (10);
l_MensajeRaw LONG RAW;
v_directorio VARCHAR2 (4000);
v_TipoMensaje VARCHAR2 (10) := 'ATTACH';
v_Adjuntos VARCHAR2 (4000) := p_ArchivosAdjuntos;
--Procedimiento para escritura de Headers
-----------------------------------------------------------------
PROCEDURE send_header (name IN VARCHAR2,
header IN VARCHAR2,
p_codigoError IN OUT VARCHAR2,
p_MensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT VARCHAR2)
AS
BEGIN
UTL_SMTP.write_data (c, name || ': ' || header || UTL_TCP.CRLF);
EXCEPTION
WHEN OTHERS
THEN
p_codigoError := '999992';
p_mensajeUsuario := 'Problemas al enviar el correo.';
p_mensajeTecnico :=
'[PROC_ENVIAR_EMAIL_ATTACHMENT.send_header]-->' || SQLERRM;
END;
-----------------------------------------------------------------
--Procedimiento para Adición de Destinatarios
-----------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_rcpt (p_Destinatarios IN VARCHAR2,
p_codigoError IN OUT VARCHAR2,
p_MensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT VARCHAR2)
AS
l_Cadena VARCHAR2 (500) := p_Destinatarios;
l_LargoCadena NUMBER;
l_Comas NUMBER;
l_PosicionComa NUMBER := 0;
l_Destinatario VARCHAR2 (100);
BEGIN
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
EXCEPTION
WHEN OTHERS
THEN
p_codigoError := '999993';
p_mensajeUsuario := 'Problemas al agregar destinatarios.';
p_mensajeTecnico :=
'[PROC_ENVIAR_EMAIL_ATTACHMENT.add_rcpt]-->' || SQLERRM;
END;
END;
---------------------------------------------------------------------------------------------------------------------------------
-- Procedimiento de adición de cabeceras para destinatarios
---------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_headers_rcpt (p_Destinatarios IN VARCHAR2,
p_Type IN VARCHAR2,
p_codigoError IN OUT VARCHAR2,
p_MensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT VARCHAR2)
AS
l_Cadena VARCHAR2 (500) := p_Destinatarios;
l_LargoCadena NUMBER;
l_Comas NUMBER;
l_PosicionComa NUMBER := 0;
l_Destinatario VARCHAR2 (100);
BEGIN
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,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
ELSE
send_header ('Cc',
l_Destinatario,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
ELSE
send_header ('Cc',
l_Destinatario,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
END IF;
-- Fin Bloque 2
EXCEPTION
WHEN OTHERS
THEN
p_codigoError := '999994';
p_mensajeUsuario :=
'Problemas al enviar el correo adicionando destinatarios.';
p_mensajeTecnico :=
'[PROC_ENVIAR_EMAIL_ATTACHMENT.add_headers_rcpt]-->'
|| SQLERRM;
END;
END;
----------------------------------------------------------------------------------------------------------------------------------------------
-- Procedimiento para adjuntar los archivos al stream del correo
---------------------------------------------------------------------------------------------------------------------
PROCEDURE file_attach (p_Archivo VARCHAR2,
p_codigoError IN OUT VARCHAR2,
p_MensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT 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
BEGIN
-- Escribir cabecera MIME
UTL_SMTP.write_data (c, '--MIME.Bound' || UTL_TCP.CRLF);
send_header ('Content-Type',
'application/octet-stream; name="' || p_Archivo || '"',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Transfer-Encoding',
'base64',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Disposition',
'attachment; filename="' || p_Archivo || '"',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
UTL_SMTP.write_data (c, UTL_TCP.CRLF);
-- Adición del Archivo
src_file := BFILENAME (v_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);
EXCEPTION
WHEN OTHERS
THEN
p_codigoError := '999995';
p_mensajeUsuario :=
'Problemas al enviar el correo adicionando archivos adjuntos.';
p_mensajeTecnico :=
'[PROC_ENVIAR_EMAIL_ATTACHMENT.file_attach]-->' || SQLERRM;
END;
END;
------------------------------------------------------------------------------------------------------------------------------------
--Procedimiento para separación y Adición de Archivos Adjuntos
------------------------------------------------------------------------------------------------------------------------------------
PROCEDURE add_attachments (p_Adjuntos IN VARCHAR2,
p_codigoError IN OUT VARCHAR2,
p_MensajeUsuario IN OUT VARCHAR2,
p_mensajeTecnico IN OUT VARCHAR2)
AS
l_Cadena VARCHAR2 (5000) := p_Adjuntos;
l_LargoCadena NUMBER;
l_Comas NUMBER;
l_PosicionComa NUMBER := 0;
l_Archivo VARCHAR2 (1000);
-- Variables para el procesamiento de Archivos
rfile RAW (57);
flen NUMBER;
bsize NUMBER;
src_file BFILE;
buffer_ INTEGER := 57;
i INTEGER := 1;
BEGIN
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,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
-- Fin Bloque 2
EXCEPTION
WHEN OTHERS
THEN
p_codigoError := '999996';
p_mensajeUsuario :=
'Problemas al enviar el correo adicionando archivos adjuntos.';
p_mensajeTecnico :=
'[PROC_ENVIAR_EMAIL_ATTACHMENT.add_attachments]-->' || SQLERRM;
END;
END;
---------------------------------------------------------------------------------------------------------------------------------
-- Inicio del Programa Core para el correo
BEGIN
p_codigoError := '000000';
p_mensajeUsuario := NULL;
p_mensajeTecnico := NULL;
-- Bloque de Apertura de Conexión
l_PuertoSMTP :=
NVL (PARAM.Parametro_General ('PORT_SERVIDOR_EMAIL', 'PA'), 25); --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,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
END IF;
IF p_DestinatariosCC IS NOT NULL
THEN
add_rcpt (p_DestinatariosCC,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
END IF;
IF p_DestinatariosBcc IS NOT NULL
THEN
add_rcpt (p_DestinatariosBcc,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
END IF;
IF p_DestinatariosCC IS NOT NULL
THEN
add_headers_rcpt (p_DestinatariosCC,
'CC',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
END IF;
-- Demás Cabeceras
send_header ('From',
p_Remitente,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico); -- De
send_header ('MIME-Version',
'1.0',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Type',
'multipart/mixed; boundary="MIME.Bound"',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
-- Escritura del Asunto
--l_MensajeRaw := UTL_RAW.cast_to_raw ('Subject:' || p_Asunto);
--UTL_SMTP.write_raw_data (c, l_MensajeRaw);
send_header ('Subject',
p_Asunto,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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 v_TipoMensaje = 'TEXT'
THEN
send_header ('MIME-Version',
'1.0',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Type',
'text/plain; charset=iso-8859-1',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Disposition',
'inline',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
ELSE
send_header ('MIME-Version',
'1.0',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Type',
'text/html;charset=iso-8859-1',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Disposition',
'inline',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
send_header ('Content-Transfer-Encoding',
'8bit',
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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 AND INSTR (p_ArchivosAdjuntos, '/') > 0
THEN
v_Directorio :=
SUBSTR (p_ArchivosAdjuntos, 1, INSTR (p_ArchivosAdjuntos, '/') - 1);
v_Adjuntos :=
SUBSTR (p_ArchivosAdjuntos, INSTR (p_ArchivosAdjuntos, '/') + 1);
ELSE
v_Directorio := OBTIENE_PARAMETRO('DIR_ACH_SERVIDOR_BD');
END IF;
add_attachments (p_ArchivosAdjuntos,
p_codigoError,
p_mensajeUsuario,
p_mensajeTecnico);
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);
p_codigoError := '999998';
p_mensajeUsuario := 'Problemas a enviar el correo.';
p_mensajeTecnico := '[PROC_ENVIAR_EMAIL_ATTACHMENT]-->' || SQLERRM;
WHEN OTHERS
THEN
-- Bloque de Cierre de Conexión
UTL_SMTP.quit (c);
p_codigoError := '999999';
p_mensajeUsuario := 'Problemas a enviar el correo.';
p_mensajeTecnico := '[PROC_ENVIAR_EMAIL_ATTACHMENT]-->' || SQLERRM;
END PROC_ENVIAR_EMAIL_ATTACHMENT;
- /
