Envío de Correos utilizando UTL_SMTP 1.2

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.