Envío de Correos utilizando UTL_SMTP

Nueva Versión!

Se ha publicado una actualización al procedimiento en el siguiente enlace

Puedes seguir leyendo este post como referencia.

---

Desde que inicié en el mundo Oracle, me he encontrado con muchas implementaciones que te permiten hacer ciertos procesos desde la BD sin necesidad de hacerlos desde un programa externo. En esta ocasión veremos el envío de correos.

Tanto en la documentación de Oracle como en la web encontrarás muchos ejemplos y documentación, sin embargo ninguno (creo yo aplicado a un entorno real) y sin "partes ocultas".

A continuación mostraré un procedimiento que utiliza el package UTL_SMTP con el cual se pueden enviar correos a múltiples destinatarios en el Para, CC y CCO, así como múltiples adjuntos.

He de mencionar que tiene sus requerimientos.

1. La lista de destinatarios y de archivos debe estar separadas por punto y coma (;) y sin espacios entre ellos (esta condición la pueden cambiar modificando el fuente), Ejemplo: 'usuario.uno@dominio.com;usuario.dos@dominio.dos.mx;usuario.tres@otrodominio.com'
2. El procedimiento hace uso de un directorio lógico en donde se alojan los archivos a adjuntar, por lo que es necesario creen el directorio con el nombre que requieran en su BD y ahi coloquen los archivos.
3. Se debe especificar el tipo de correo, ya sea HTML (en el parametro se coloca 'HTML') o Texto, que es el valor por default.

Ya con esto aclarado y recordandoles que hay comentarios dentro del código, puedo decirles que con este ejemplo pueden basarse para hacer uno sin envío de adjuntos (innecesario para mi gusto, pues con el solo hecho de mandar la cadena vacía, no se manda nada).

create or replace procedure P_SendMailAttach

(

p_DestinatariosPara     VARCHAR2, 

p_DestinatariosCC       VARCHAR2 DEFAULT NULL,

p_DestinatariosBcc      VARCHAR2 DEFAULT NULL,

p_Mensaje               VARCHAR2 DEFAULT 'Haga caso omiso a este mensaje',

p_Remitente             VARCHAR2 DEFAULT 'usuario@midominio',

p_Asunto                VARCHAR2 DEFAULT 'Este correo no tiene asunto',

p_TipoMensaje           VARCHAR2 DEFAULT 'TEXT',

p_Directorio            VARCHAR2 DEFAULT 'ATTACHMENTS', -- Directorio lógico por default

p_ArchivosAdjuntos      VARCHAR2

)

AS

-- ----------------------------------------------------------------------------------------------

-- Nombre            : P_SendMailAttach

-- Autor             : Ing. Rogelio "Wazu" Rodriguez

-- Descripcion       : Envio de correos utilizando el package UTL_SMTP

-- Requerimientos    : UTL_SMTP

-- Restricciones     :

-- Revisiones:

--   Fecha        Desarrollador                 Cambio

--   ===========  ========================      =================================================

--   03-APR-2012  Rogelio Wazu Rodriguez        Creación Inicial
--   30-JUL-2012  Rogelio Wazu Rodriguez        Se modifica en el procedure
                                                file_attach en content transfer
                                                sea después de Disposition

-- ----------------------------------------------------------------------------------------------

c utl_smtp.connection;

--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_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_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-Disposition', 'attachment; filename="' || p_Archivo || '"');
    send_header('Content-Transfer-Encoding', 'base64' );

    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_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));

              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

    c := utl_smtp.open_connection('165.254.254.32',25);  --Recuerden que puede ser el nombre NetBios o la IP

    utl_smtp.helo(c, '165.254.254.32'); 

    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;

    send_header('Subject', p_Asunto); --Asunto

    send_header('From', p_Remitente); -- De

    send_header('MIME-Version','1.0');

    send_header('Content-Type','multipart/mixed; boundary="MIME.Bound"');

    utl_smtp.write_data(c,'--MIME.Bound'||utl_tcp.CRLF);

    send_header('MIME-Version','1.0');

    

    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=us-ascii');

            send_header('Content-Disposition', 'inline');

        ELSE

            send_header('MIME-Version','1.0');

            send_header('Content-Type', 'text/html;charset=windows-1252');

            send_header('Content-Disposition', 'inline');

            send_header('Content-Transfer_Encoding', '8bit');

        END IF;

    

    END IF;

    -- Bloque de Escritura del Mensaje 

    utl_smtp.write_data(c, utl_tcp.CRLF ||p_Mensaje||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(-20000, 'Unable to send mail: '||sqlerrm);

     WHEN OTHERS THEN

        -- Bloque de Cierre de Conexión

        utl_smtp.quit(c); 

        raise_application_error(-20000, 'Unable to send mail: '||sqlerrm);

    END;

END;

/ 

-- Ejemplo de uso

exec              P_SENDMAILATTACH(p_DestinatariosPara =>'usuario.uno@empresa1.com;usuario.dos@empresa2.com',

                                   p_DestinatariosCC => 'usuario@otraempresa.com',

                                   p_Remitente => 'InformesEmpresa1@empresa1.com',

                                   p_Mensaje =>'<h1> Informe </h1> <p>Cuerpo del Informe</p>',

                                   p_Asunto => 'Envío de Informe Empresa1',

                                   p_ArchivosAdjuntos => 'a6.pdf;a1.csv;A3.xml;A5.PDF;a6.txt',

                                   p_TipoMensaje => 'HTML');

Espero les sea de utilidad el código y les confirmo que funciona al 100%, cualquier pregunta o comentario, pueden dejarlo en este post.