oracle 利用clob發送內容大於32767長度的email package

utl_mail 發送email當內容大於 32767時就無法處理,
所以寫了個plsql package ,利用clob發送.內容, 附檔用blob .

測試代碼1:

begin
  pkg_mail.send_mail('[e-mail]','[e-mail]',
     subject => '測試',
     message => '測試email',
    mime_type => 'text/plain; charset=big5'
  ) ;
end ;

測試代碼2

begin
  pkg_mail.send_mail('[e-mail]','[e-mail]',
  subject => '測試',
  message => utl_lob.get_clob('MAILTEMP','jxxx_cc1.html'),
  mime_type => 'text/html; charset=big5',
  attachment=>utl_lob.get_blob('MAILTEMP','test.xls'),
  att_filename=>'test.xls'

  ) ;
end ;

email發送package

create or replace package PKG_MAIL is
/****************************************
   Ver        Date        Author           Description
   ---------  ----------  ---------------  ------------------------------------
   1.0        2013-08-14   gangjh           1. pl/sql發送email
*****************************************************************/

  type string_array is table of varchar2(200) ;

  FUNCTION split_string (
    p_str IN VARCHAR2,
    p_delim IN VARCHAR2 default(';') --分隔符，默認分號
 ) RETURN string_array pipelined ;



  subtype handle is number ;


  function open_mail return number ;
  /*
  @set_attribute
   id: 'from'     mailfrom;
       'to'       mailto ;
       'cc'       ccto  ;
       'subject'  subject  ;
  */
  procedure set_attribute(ctx  handle, id varchar, val varchar2) ;

  procedure set_trans_info(p_smtphost varchar2, p_auth varchar2, p_pass varchar2);


  PROCEDURE set_content(ctx handle, data IN CLOB, mime_type VARCHAR2);

  PROCEDURE set_attach(ctx handle, data IN blob, filename VARCHAR2) ;

  PROCEDURE send(ctx  handle, vhost VARCHAR2, vport NUMBER DEFAULT 25, auth_login in varchar2 default null, auth_pass in varchar2 default null);

  function get_MimeMessage(ctx in handle) return clob ;

  PROCEDURE close_mail(ctx handle);

   PROCEDURE send_mail(
                 sender IN VARCHAR2 ,
                 recipients IN VARCHAR2 ,
                 cc IN VARCHAR2 DEFAULT NULL,
                 bcc IN VARCHAR2 DEFAULT NULL,
                 subject IN VARCHAR2 DEFAULT NULL,
                 message IN CLOB DEFAULT NULL,
                 mime_type IN VARCHAR2 DEFAULT 'text/plain; charset=us-ascii',
                 priority IN PLS_INTEGER DEFAULT 3,
                 attachment IN BLOB default null,
                 att_inline IN BOOLEAN DEFAULT TRUE,
                 att_mime_type IN VARCHAR2 DEFAULT 'text/plain; charset=us-ascii',
                 att_filename IN VARCHAR2 DEFAULT NULL) ;

end PKG_MAIL;


/
create or replace package body PKG_MAIL is
/*
+------------------------- multipart/mixed ----------------------------+
|                                                                      |
|  +----------------- multipart/related ------------------+            |
|  |                                                      |            |
|  |  +----- multipart/alternative ------+  +----------+  |  +------+  |
|  |  |                                  |  | 內嵌資源 |  |  | 附件 |  |
|  |  |  +------------+  +------------+  |  +----------+  |  +------+  |
|  |  |  | 純文本正文 |  | 超文本正文 |  |                |            |
|  |  |  +------------+  +------------+  |  +----------+  |  +------+  |
|  |  |                                  |  | 內嵌資源 |  |  | 附件 |  |
|  |  +----------------------------------+  +----------+  |  +------+  |
|  |                                                      |            |
|  +------------------------------------------------------+            |
|                                                                      |
+----------------------------------------------------------------------+
可以看出，如果在郵件中要添加附件，必需定義multipart/mixed段；
   如果存在內嵌資源，至少要定義multipart/related段；
   如果純文本与超文本共存，至少要定義multipart/alternative段。
      什么是“至少”？??例子?，如果只有純文本与超文本正文，那么在郵件頭中將類型擴大化，定義為multipart/related，甚至multipart/mixed，都是允許的。

multipart諸類型的共同特征是，
  在段頭指定“boundary”參數字符串，  段体內的每個子段以此串定界。
  所有的子段都以“--”+boundary行開始，
    父段則以“--”+boundary+“--”行結束。
     段与段之間也以空行分隔。
     在郵件体是multipart類型的情況下，郵件体的開始部分(第一個“--”+boundary行之前)可以有一些附加的文本行，相當于注釋，解碼時應忽略。
     段間也可以有一些附加的文本行，不會顯示出來，

*/
 type mail_addr_rec is record(
    address varchar2(200),
    username varchar2(200),
    enc_addr varchar2(200)
    );
  type mail_addr_t is table of mail_addr_rec index by pls_integer ;

  TYPE mail_content_t IS RECORD(
    data CLOB,
    mime_type VARCHAR2(200),
    filename VARCHAR2(200));
  type attach_table is table of mail_content_t index by pls_integer ;

  type mail_data_type is record(
    v_subject varchar2(2000),
    charset varchar2(20),
    m_from   mail_addr_rec,
    m_to     mail_addr_t,
    m_cc     mail_addr_t,
    m_bcc    mail_addr_t,
    reply_to mail_addr_rec,
    priority pls_integer,
    m_body   mail_content_t,
    attach attach_table
    );
  type mail_table is table of mail_data_type ;


 crlf        CONSTANT char(1):= chr(10);
 default_mail_host varchar2(200) ;
 smtp_auth_user varchar2(200) ;
 smtp_auth_pass varchar2(200) ;

v_maillist mail_table := mail_table() ;

 procedure print(m varchar2) is
 begin
   dbms_output.put_line(m) ;
 end ;

--以分號切割string
function split_string(p_str in varchar2,
                      p_delim in varchar2 default(';'))
         return string_array pipelined
as
  l_str long := p_str || p_delim;
  l_n number;
begin
  loop
    l_n := instr(l_str, p_delim);
    exit when (nvl(l_n,0) = 0);
    pipe row (ltrim(rtrim(substr(l_str,1,l_n-1))));
    l_str := substr(l_str, l_n +1);
  end loop;
  return;
end ;

  function string_to_base64(s varchar2) return varchar2 is
  begin
    return utl_raw.cast_to_varchar2(utl_encode.base64_encode(utl_raw.cast_to_raw(s)));
  end ;

  function blob_to_base64( src in blob) return clob is
    --取 3 的倍數 因為如果需要按照64字符每行分行，所以需要是16的倍數，所以下面的長度必需為 48的倍數
    dest CLOB ;
    sizeB integer := 6144;
    buffer raw(6144);
    offset integer default 1;
  begin
    dbms_lob.createtemporary(dest, true, dbms_lob.call) ;
    while offset <= dbms_lob.getlength(src) LOOP
       dbms_lob.read(src, sizeB, offset, buffer);
       offset := offset + sizeB;
       dbms_lob.append(dest, to_clob(utl_raw.cast_to_varchar2(utl_encode.base64_encode(buffer))));
    end loop;
    return dest ;
  END blob_to_base64;


  function clob_to_base64( src IN CLOB ) return clob IS
    v_blob blob;
    v_blob_offset int :=1;
    v_clob_offset int :=1 ;
    v_lang_context NUMBER := DBMS_LOB.DEFAULT_LANG_CTX;
    v_warning integer ;
  BEGIN
    IF src IS NULL THEN
      RETURN null;
    END IF ;
    dbms_lob.createtemporary(v_blob, true, dbms_lob.call) ;

    dbms_lob.converttoblob(v_blob,
                          src,
                          dbms_lob.getlength(src),
                          v_blob_offset,
                          v_clob_offset,
                          dbms_lob.default_csid ,
                          v_lang_context,
                          v_warning);
    return blob_to_base64(v_blob) ;
  END ;

 procedure write_line(l in out nocopy clob , msg varchar2) is
 begin
    if length(msg) >0 then
        dbms_lob.writeappend(l, length(msg), msg) ;
    end if ;
    dbms_lob.writeappend(l, 1, crlf) ;
 end write_line;

--第2行需要有前置空格
 FUNCTION encstr(m VARCHAR2) RETURN VARCHAR2 IS
 BEGIN
    return replace( utl_encode.mimeheader_encode(m, null, 1),chr(10), chr(10)||chr(9) ) ;
--    RETURN '=?utf-8?B?'|| replace(string_to_base64(m), chr(10), chr(10)||chr(9))||'?=' ;
 END ;

/********************
發件時間:固定格式
ex:
Date: Wed, 20 Nov 2013 14:13:06 +0800
********************/
 function get_datestr return varchar2 is
 begin
   return TO_CHAR(SYSDATE,'Dy, dd Mon yyyy hh24:mi:ss ', 'NLS_DATE_LANGUAGE = American')||
                   replace(sessiontimezone,':','') ;
 end ;


  /* ---begin  parase address
  @escape_address  -- 解析 email address
   mail_alias   或mail-address
  分拆開來
  p_addr.address :=
  p_addr.username := user alias
  *********/
 procedure escape_address(p_to in varchar2, p_addr in out mail_addr_rec) is
   i int ;
   v_to varchar2(32760) := trim(replace(replace(p_to, chr(10),''), chr(13),'')) ;
   begin
    i := instr(v_to,'<') ;
    if i >0 then
      p_addr.username := trim(substr(v_to, 1, i-1)) ;
      p_addr.address := trim(substr(v_to, i)) ;
    else
      p_addr.address := '<'|| v_to ||'>' ;
      p_addr.username := substr(v_to, 1, instr(v_to, '@')-1) ;
    end if;

    p_addr.enc_addr :=
        case
        when p_addr.username is null then p_addr.address
        else encstr(p_addr.username) ||p_addr.address
        end ;
   end ;

   procedure parser_address(v_to in varchar2 , out_addr in out mail_addr_t ) is
     idx int ;
     aa  mail_addr_rec ;
   begin
     if v_to is null or length(v_to) =0 then
       return ;
     end if ;

     for r in (select trim(column_value) data from table(split_string(replace(v_to,',',';'), ';'))
         where length(trim(column_value)) >5
        )
     loop
         idx := out_addr.count + 1 ;
         escape_address(trim(r.data), aa) ;
         out_addr(idx) := aa ;
     end loop;
  end parser_address;

/****************
@addr_to_str --   將收件者數組轉為編碼後的字串
   第2個mail_address前需有空格
*****************/
   function addr_to_str(v mail_addr_t, p_delim in varchar2 default chr(9)) return varchar2 is
   tmp varchar2(32767) ;
   begin
     if v.count <=0 then
       return null;
     end if;

     for i in v.first .. v.last  loop
      if v.exists(i) then
          tmp := tmp || p_delim || v(i).enc_addr ||','||crlf ;
      end if;
    end loop ;
    -- "," +crlf size=2
    return substr(tmp, 1, length(tmp)-2) ;
   end addr_to_str;

 function open_mail return number is
   x number ;
   d mail_data_type ;
 BEGIN
   v_maillist.extend() ;
   x := v_maillist.last() ;
   v_maillist(x) := d;
   return x ;
 END open_mail;




 procedure set_attribute(ctx  handle, id varchar, val varchar2) is
   x varchar2(20) := lower(id) ;
 begin
   case
     when x = 'from' then escape_address(val, v_maillist(ctx).m_from ) ;
     when x = 'to' then parser_address(val, v_maillist(ctx).m_to ) ;
     when x = 'cc' then parser_address(val, v_maillist(ctx).m_cc) ;
     when x = 'bcc' then parser_address(val, v_maillist(ctx).m_bcc) ;
     when x = 'reply-to' then escape_address(val, v_maillist(ctx).reply_to) ;
     when x = 'priority' then v_maillist(ctx).priority := val ;
     when x = 'subject' then v_maillist(ctx).v_subject := val ;
     when x = 'charset' then v_maillist(ctx).charset := val ;

   else
     raise_application_error(-20013, '不支持參數 [ '||id||' ]') ;
   end case ;

 end ;

 procedure set_trans_info(p_smtphost varchar2, p_auth varchar2, p_pass varchar2) is
 begin
   default_mail_host := p_smtphost;
   smtp_auth_user := p_auth ;
   smtp_auth_pass := p_pass;
 end ;



 PROCEDURE set_content(ctx  handle ,data IN CLOB , mime_type VARCHAR2 ) IS
 BEGIN
   v_maillist(ctx).m_body.data := clob_to_base64(data) ;
   v_maillist(ctx).m_body.mime_type := mime_type ;
 END ;

 PROCEDURE set_attach(ctx  handle, data IN blob, filename VARCHAR2 ) IS
 idx pls_integer ;
 BEGIN
    idx := v_maillist(ctx).attach.count() +1;
    v_maillist(ctx).attach(idx).filename := filename ;
    v_maillist(ctx).attach(idx).data := blob_to_base64(data) ;
 END ;



 /********************
  multipart/mixed
       multipart/alternative;
 將email編碼內容寫入blob
*************************/
 procedure mime_mail_multipart(lob_loc in out nocopy clob, m in mail_data_type ) is
   mail_bonndary1 CONSTANT VARCHAR2(200) :='----=_Part_1_922723413.1367658258997';


   procedure set_header(n in varchar2 ,v in varchar2) is
   begin
     write_line(lob_loc, n ||': '||v ) ;
   end set_header;

   PROCEDURE write_header IS
   BEGIN

  /*Reply-to: 回復地址 */
    if m.reply_to.address is not null then
       set_header('Reply-To', m.reply_to.enc_addr );
    end if;
    set_header('From', m.m_from.enc_addr );
    set_header('To', addr_to_str(m.m_to ) );

    if m.m_cc.count >0 then
      set_header('CC', addr_to_str(m.m_cc) );
    end if;

    set_header('Subject', encstr(m.v_subject) );

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

    set_header('Content-Type','multipart/mixed;
        boundary="'|| mail_bonndary1 ||'"');

--    set_header(l, 'Content-Language', v_mail_charset ) ;
    set_header('X-Priority', nvl(m.priority,3));

    set_header('Date', get_datestr() ) ;
    set_header('X-MSMail-Priority','Normal');
    set_header('X-Mailer','Microsoft Outlook Express 6.00.2900.5931');
    set_header('X-MimeOLE','Produced By Microsoft MimeOLE V6.00.2900.6157');

    write_line(lob_loc, '') ;
    write_line(lob_loc, 'This is a multi-part message in MIME format.') ;
    write_line(lob_loc, dbms_utility.format_call_stack) ;
    write_line(lob_loc, crlf||crlf );


 END write_header;


 PROCEDURE   write_mail_body(bonndary varchar2 ) IS
    mail_bonndary2 CONSTANT VARCHAR2(200) :='----=_Part_2_922723413.136765825899X';
 BEGIN
  /* multipart/alternative */
    write_line(lob_loc, '--'||bonndary ) ;

    set_header('Content-Type', 'multipart/alternative;
      boundary="'||mail_bonndary2 ||'"') ;
    write_line(lob_loc, '') ; -- 空行

    write_line(lob_loc, '--'||mail_bonndary2 ) ;
    set_header('Content-Type', m.m_body.mime_type );
    set_header('Content-Transfer-Encoding','base64');
    write_line(lob_loc, crlf);

    dbms_lob.append(lob_loc, m.m_body.data);

    write_line(lob_loc,'') ;
    write_line(lob_loc, '--'||mail_bonndary2 ||'--') ;
    write_line(lob_loc, '') ;
 END write_mail_body;


 PROCEDURE   write_mail_attach(attach mail_content_t, bonndary varchar2 ) IS
 BEGIN
    if attach.data is null or dbms_lob.getlength(attach.data ) <=0
    then
      return ;
    end if;

    write_line(lob_loc, '--'||bonndary ) ;
    set_header('Content-Transfer-Encoding', 'base64');
    set_header('Content-Disposition', 'attachment;
      filename="'||encstr( attach.filename )||'"') ;

    write_line(lob_loc, crlf) ;

    dbms_lob.append(lob_loc, attach.data);

    write_line(lob_loc, crlf);
 END write_mail_attach;

   begin
 --   set_header(lob_loc, 'In-Reply-To','');


    write_header() ;

    write_mail_body(mail_bonndary1) ;
    for i in 1.. m.attach.count() loop
        write_mail_attach(m.attach(i) , mail_bonndary1) ;
    end loop;

   --end send mailbody data
    write_line(lob_loc, '--'||mail_bonndary1 || '--') ;

   end mime_mail_multipart;


 function get_MimeMessage(ctx in handle) return clob
 is
   clob_loc clob;
 begin
    dbms_lob.createtemporary(clob_loc, true, dbms_lob.call) ;
    mime_mail_multipart(clob_loc, v_maillist(ctx) );
    return clob_loc ;
 end ;


   procedure smtp_send_content(l IN OUT NOCOPY utl_smtp.connection, lob_loc in out nocopy clob) is
   offset number := 1;
   lc_buffer varchar2(32767);
   amount number := 30000 ;
   begin
      while offset <= dbms_lob.getlength(lob_loc) LOOP
        dbms_lob.read(lob_loc, amount , offset, lc_buffer) ;
        offset := offset + amount ;
        utl_smtp.write_raw_data(l, utl_raw.cast_to_raw(lc_buffer)) ;
    end loop;
    utl_smtp.write_data(l, crlf);

 end smtp_send_content;


 procedure smtp_auth(l in out nocopy utl_smtp.connection ,username varchar2 , password varchar2) is
 begin
    if username is null or password is null then
      return ;
    end if ;

    utl_smtp.command(l, 'AUTH LOGIN');
    utl_smtp.command(l, string_to_base64(username)) ;
    utl_smtp.command(l, string_to_base64(password)) ;
 end smtp_auth;

--指明email收件者
 PROCEDURE smtp_rcpt(l in out nocopy utl_smtp.connection, addr mail_addr_t ) IS
 begin
    if addr.count() <=0 then
       return ;
    end if ;

    for i in addr.first .. addr.last  loop
      begin
        utl_smtp.rcpt(l, addr(i).address);
      exception
        when utl_smtp.permanent_error then
          print(dbms_utility.format_call_stack||' deny:'||addr(i).address) ;
          raise_application_error(-20014,' deny:'||addr(i).address||chr(10)||sqlerrm);
      end ;
    end loop;
 end smtp_rcpt;

 PROCEDURE send(ctx  handle, vhost VARCHAR2, vport NUMBER DEFAULT 25, auth_login in varchar2 default null, auth_pass in varchar2 default null ) IS
   l_conn   utl_smtp.connection ;
   msg clob ;
   m mail_data_type ;
 BEGIN
    m := v_maillist(ctx) ;

    dbms_lob.createtemporary(msg, true, dbms_lob.call);
    mime_mail_multipart(msg, m) ;
    if m.m_to.count()<1 then
      raise_application_error(-20013,'收件者不能為空') ;
    end if;

    l_conn := utl_smtp.open_connection(vhost, vport, tx_timeout=>15) ;

    utl_smtp.helo(l_conn, vhost);

    smtp_auth(l_conn, auth_login, auth_pass) ;

    utl_smtp.mail(l_conn, m.m_from.address) ;
    smtp_rcpt(l_conn, m.m_to) ;
    smtp_rcpt(l_conn, m.m_cc) ;
    smtp_rcpt(l_conn, m.m_bcc) ; --秘件收件者

    utl_smtp.open_data(l_conn);
    smtp_send_content(l_conn, msg);
    utl_smtp.close_data(l_conn);

    utl_smtp.quit(l_conn);

    dbms_lob.freetemporary(msg) ;
    exception
      when utl_smtp.permanent_error or utl_smtp.invalid_operation then
        utl_smtp.quit(l_conn);
        raise;
      when others then
          raise;
 END send ;


 PROCEDURE close_mail(ctx handle) IS
 BEGIN
    v_maillist.delete(ctx) ;
    v_maillist.trim() ;
 END ;


 --parameter keep same as utl_mail.send_attach_varchar2
 PROCEDURE send_mail(
                 sender IN VARCHAR2 ,
                 recipients IN VARCHAR2 ,
                 cc IN VARCHAR2 DEFAULT NULL,
                 bcc IN VARCHAR2 DEFAULT NULL,
                 subject IN VARCHAR2 DEFAULT NULL,
                 message IN CLOB DEFAULT NULL,
                 mime_type IN VARCHAR2 DEFAULT 'text/plain; charset=us-ascii',
                 priority IN PLS_INTEGER DEFAULT 3,
                 attachment IN BLOB default null,
                 att_inline IN BOOLEAN DEFAULT TRUE,
                 att_mime_type IN VARCHAR2 DEFAULT 'text/plain; charset=us-ascii',
                 att_filename IN VARCHAR2 DEFAULT NULL) is
    ctx pkg_mail.handle ;
  BEGIN
     ctx := pkg_mail.open_mail() ;
     set_attribute(ctx, 'from', sender) ;
     set_attribute(ctx, 'to', recipients) ;
     set_attribute(ctx, 'cc', cc) ;
     set_attribute(ctx, 'bcc', bcc) ;
     set_attribute(ctx, 'subject', subject) ;
     set_attribute(ctx, 'priority', priority) ;

     set_content(ctx, message, mime_type) ;

     if length(att_filename) >0 and attachment is not null then
       set_attach(ctx, attachment, att_filename ) ;
     end if;

     send(ctx, default_mail_host, 25, smtp_auth_user, smtp_auth_pass);
     close_mail(ctx) ;
end ;

begin

declare
 xx binary_integer ;
 ff binary_integer ;
begin
 xx := sys.dbms_utility.get_parameter_value(parnam => 'smtp_out_server',
                                            intval => ff,
                                            strval => default_mail_host,
                                            listno => 1);
end ;

end PKG_MAIL;
/

 2014/03/08修改

阿飛