Ver Mensaje Individual
  #5 (permalink)  
Antiguo 25/06/2008, 11:02
Michelc
 
Fecha de Ingreso: enero-2008
Mensajes: 63
Antigüedad: 16 años, 3 meses
Puntos: 1
De acuerdo Respuesta: Procedimiento de envio de correo

Hola encontre un código en ZonaOracle.com y lo adecue a mis necesidades, esta muy bueno.

Código:
CREATE OR REPLACE procedure SIS.ejemplo3(
       phost            varchar2,   -- IP del servidor de correo
       premitente       varchar2,   -- Remitente
       pdestinatario    varchar2,   -- Destinatario
       pcc              varchar2,   -- Con copia
       pasunto          varchar2,   -- Asunto
       pcuerpo          varchar2)   -- Cuerpo del mensaje
-- Permite enviar un correo electrónico incluyendo un destinatario
is
       vconexion    utl_smtp.connection;
       
       -- Se construye la cabezera del mensaje
       function cabezera(
            vremitente     varchar2,
            vasunto        varchar2,
            vdestinatario  varchar2,
            vcc            varchar2)
       return varchar2
       is
            vcabezera   varchar2(32767);
       begin
            vcabezera := 'Return-Path: '||vremitente|| utl_tcp.crlf ||
                         'Sent: '||to_char(sysdate,'dd Mon yy hh24:mi:ss')|| utl_tcp.crlf ||
                         'From: '||vremitente|| utl_tcp.crlf ||
                         'Subject: '||vasunto|| utl_tcp.crlf ||
                         'To: '||vdestinatario|| utl_tcp.crlf ||
                         'Cc: '||vcc|| utl_tcp.crlf ||
                         'MIME-Version: 1.0'|| utl_tcp.crlf || -- use mime mail standard
                         'Content-Type: multipart/mixed; boundary="MIME.Bound"'|| utl_tcp.crlf || --mime.bound really should be a randomly generated string
                         'Content-Type: text/plain; charset=iso-8859-1'|| utl_tcp.crlf || 
                         'Content-Disposition: inline;' || utl_tcp.crlf ||
                         'Content-Transfer_Encoding: 8bit'|| utl_tcp.crlf;

            return vcabezera; 
       end;
       
       -- Se construye el cuerpo del mensaje
       function cuerpo(
            pbody       varchar2)
       return varchar2
       is
            vcadena     varchar2(10000);
            vposicion   number;
       begin
            -- Se procesa el mensaje, separandolo previamente de la cabezera con un crlf
            vcadena := pbody;
            vposicion := instr(vcadena,chr(10),1);
            while (vposicion<>0) loop
                    utl_smtp.write_data(vconexion, utl_tcp.crlf || substr(vcadena,1,vposicion-1));
                    vcadena   := ltrim(rtrim(substr(vcadena,vposicion+1)));
                    vposicion := instr(vcadena,chr(10),1);
            end loop;
            return vcadena;
       end;
              
begin
    -- Se establece la conexión al servidor de correo
    vconexion := utl_smtp.open_connection(phost);
        
    -- Se negocia la transacción con el servidor smtp
    utl_smtp.helo(vconexion, phost);
    utl_smtp.mail(vconexion, premitente);
    utl_smtp.rcpt(vconexion, pdestinatario);
    -- Si se envia copia a otro destinatario
    if ltrim(rtrim(pcc)) is not null then
        utl_smtp.rcpt(vconexion, pcc);
    end if;
        
    utl_smtp.open_data(vconexion);
    utl_smtp.write_data(vconexion, cabezera(premitente, pasunto, pdestinatario, pcc));
    
    -- Para permitir caracteres "raros" (tildes, simbolos, ...)
    utl_smtp.write_data(vconexion,'mime-version: 1.0' || utl_tcp.crlf);
    utl_smtp.write_data(vconexion,'content-type: text/plain; charset=iso-8859-1' || utl_tcp.crlf);

    -- Preparamos el cuerpo del correo
    utl_smtp.write_data(vconexion, utl_tcp.crlf || cuerpo(pcuerpo) || utl_tcp.crlf);
    utl_smtp.write_data(vconexion, utl_tcp.crlf);
      
    -- Cerramos la conexión
    utl_smtp.close_data(vconexion);
    utl_smtp.quit(vconexion);

exception
    when others then
        raise_application_error(sqlcode,sqlerrm,true);
        raise;
end ejemplo3;
/
Saludos