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!
ola amigo te comente los otros blog del tema pero sigo con el mismo error, me puedes dar la mano que mas debo conigurar
ResponderEliminarORA-20100: Unable to send mail: ORA-29279: error permanente de SMTP: 530 5.7.0 Must issue a STARTTLS command first. i24sm3010837vkk.5 - gsmtp
ORA-06512: en "GADSPP.P_ENVIACORREOUTLSMTP", línea 295
ORA-06512: en línea 30