' ); rc := utl_tcp.write_line ( conn, subject ); rc := utl_tcp.write

CREATE OR REPLACE PACKAGE mail_tools AS -- SENDMAIL supports variable message length with/without attachments -- QUERY_SERVER allows you to check the status of a mail server to see if it is running -- DUMP_FLATFILE allows you to dump flat file data from query submitted -- -- -- Query Server to verify that the server is up and running. -- Connects, Noop Command is executed, Disconnect. -- -- GET_MAIL_ADDRESS is utilized in the SENDMAIL procedure -- -- -- -- Table 100-3 SMTP Reply Codes -- Reply Code -- Meaning -- -- 211 System status, or system help reply -- -- 214 Help message [Information on how to use the receiver or the meaning of a particular non-standard command; this reply is useful only to the human user] -- -- 220 Service ready -- -- 221 Service closing transmission channel -- -- 250 Requested mail action okay, completed -- -- 251 User not local; will forward to -- -- 252 OK, pending messages for node started. Cannot VRFY user (e.g., info is not local), but will take message for this user and attempt delivery. -- -- 253 OK, pending messages for node started -- -- 354 Start mail input; end with . -- -- 355 Octet-offset is the transaction offset -- -- 421 Service not available, closing transmission channel (This may be a reply to any command if the service knows it must shut down.) -- -- 450 Requested mail action not taken: mailbox unavailable [for example, mailbox busy] -- -- 451 Requested action aborted: local error in processing -- -- 452 Requested action not taken: insufficient system storage -- -- 453 You have no mail. -- -- 454 TLS not available due to temporary reason. Encryption required for requested authentication mechanism. -- -- 458 Unable to queue messages for node -- -- 459 Node not allowed: reason -- -- 500 Syntax error, command unrecognized (This may include errors such as command line too long.) -- -- 501 Syntax error in parameters or arguments -- -- 502 Command not implemented -- -- 503 Bad sequence of commands -- -- 504 Command parameter not implemented -- -- 521 does not accept mail. -- -- 530 Must issue a STARTTLS command first. Encryption required for requested authentication mechanism. -- -- 534 Authentication mechanism is too weak. -- -- 538 Encryption required for requested authentication mechanism. -- -- 550 Requested action not taken: mailbox unavailable [for , mailbox not found, no access] -- -- 551 User not local; please try -- -- 552 Requested mail action aborted: exceeded storage allocation -- -- 553 Requested action not taken: mailbox name not allowed [for example, mailbox syntax incorrect] -- -- 554 Transaction failed -- -- -- /* This version allows for a customized seperator value. Using this function will allow you to perform fixed width flat files by defining '' for no seperator and then RPAD/LPAD your columns as necessary. Or use whatever seperator you wish to use, pipe, space, zeros, etc. */ -- Example : This will generate a flat file which tabbed seperated -- -- DECLARE -- l_rows NUMBER; -- l_sql VARCHAR2(32000); -- BEGIN -- l_sql := ' -- SELECT rpad(hou.NAME,70) udn_desc -- , rpad(pcak.segment1,6) coid -- , rpad(pcak.segment2,4) udn -- FROM hr_all_organization_units hou, hr.pay_cost_allocation_keyflex pcak -- WHERE TRUNC (SYSDATE) BETWEEN hou.date_from -- AND NVL (hou.date_to, ''31-DEC-4712'') -- AND pcak.cost_allocation_keyflex_id = hou.cost_allocation_keyflex_id -- GROUP BY pcak.segment1, pcak.segment2, hou.NAME -- ORDER BY 1, 2, 3 -- '; -- -- l_rows := -- dump_flatfile -- (p_query => -- , p_dir => '/xfer' -- , p_filename => 'test.csv' -- , p_separator => ' ' -- <= tabbed 5 spaces between each column -- , p_max_linesize => 32000 -- , p_mode => 'w' -- (w)rite mode or (a)ppend mode -- ); -- END; FUNCTION dump_flatfile ( p_query IN VARCHAR2 , p_dir IN VARCHAR2 , p_filename IN VARCHAR2 , p_separator IN VARCHAR2 , p_headers IN BOOLEAN DEFAULT FALSE , p_trailing_separator IN BOOLEAN DEFAULT FALSE , p_max_linesize IN NUMBER DEFAULT 32000 , p_mode IN VARCHAR2 DEFAULT 'w' ) RETURN NUMBER; FUNCTION get_mail_address ( addr_list IN OUT VARCHAR2 ) RETURN VARCHAR2; FUNCTION smtp_command ( command IN VARCHAR2 , ok IN VARCHAR2 DEFAULT '250' , code OUT VARCHAR2 , DEBUG NUMBER DEFAULT 0 ) RETURN BOOLEAN; FUNCTION query_server ( smtp_server VARCHAR2 , smtp_server_port PLS_INTEGER DEFAULT 25 , DEBUG NUMBER DEFAULT 0 ) RETURN BOOLEAN; /* This procedure uses the UTL_TCP package to send an email message. Up to three file names may be specified as attachments. Written: Dave Wotton, 14/6/01 (Cambridge UK) This script comes with no warranty or support. You are free to modify it as you wish, but please retain an acknowledgement of my original authorship. Amended: Dave Wotton, 10/7/01 Now uses the utl_smtp.write_data() method to send the message, eliminating the 32Kb message size constraint imposed by the utl_smtp.data() procedure. Amended: Dave Wotton, 20/7/01 Increased the v_line variable, which holds the file attachment lines from 400 to 1000 bytes. This is the maximum supported by RFC2821, The Simple Mail Transfer Protocol specification. Amended: Dave Wotton, 24/7/01 Now inserts a blank line before each MIME boundary line. Some mail-clients require this. Amended: Dave Wotton, 4/10/01 Introduced a 'debug' parameter. Defaults to 0. If set to non-zero then errors in opening files for attaching are reported using dbms_output.put_line. Include code to hand MS Windows style pathnames. Amended: Barry Chase, 4/29/03 Added Priority to procedure and also X-Mailer ID. Removed restrictions for email size limitation as well. Emails are now formatted text messages, meaning you can write your message in html format. And finally, changed from using UTL_SMTP to UTL_TCP instead. Amended: Barry Chase 11/10/2003 Added session timeout of 4 minutes to prevent hanging server connections Amended: Barry Chase 12/04/2003 Added Date String so that it represents timezone of originating server p_datestring Amended: Barry Chase 03/01/2004 Added functionality to support binary attachments and remote attachments. Its about 98% complete. Not work perfectly yet. Still trying to figure out encoding to base64 or mime. Have a good start on it though. 04/12/2004 BCHASE :: Binary Support is fully functional now. 09/01/2005 BCHASE :: Modified attachment directories to use DBA_DIRECTORIES instead of UTL_DIR in the Oracle initialization file. 02/22/2006 BCHASE :: Added variable length message email support (CLOB) 04/21/2006 BCHASE :: Expanded functionality to include Cc and Bcc Also removed redundant calls from package. The single mail_files command will handle flat files and binary files such as zip/pdf/etc. SMTP Server and SMTP Server Port are parameters on the sendmail procedure now as well. Refer to http://home.clara.net/dwotton/dba/oracle_smtp.htm for more details on the original source code. For information on the enhanced mail_tools package as provided by Barry Chase, refer to http://www.myoracleportal.com */ /* Retrieves local binary file from database server. * using DBMS_LOB commands and stores into BLOB * * return BLOB */ FUNCTION get_local_binary_data ( p_dir IN VARCHAR2 , p_file IN VARCHAR2 ) RETURN BLOB; /* Supports binary attachments and message of variable length. Uses CLOB.*/ -- DECLARE -- t_blob BLOB; -- BEGIN -- -- Use the get_local_binary_data to collect your BLOB from the filesystem -- or just load from a table where your BLOB is stored at, then just pass -- as t_blob on the binaryfile parameter below. Remember to provide an -- appropriate filename. Optionally, you can leave filename NULL and pass -- the binaryfile parameter as EMPTY_BLOB() to send an email without an -- attachment. -- -- t_blob := -- mail_tools.get_local_binary_data -- ( p_dir => 'INTF0047_TABLES' --, p_file => 'test_file1.csv' ); -- mail_tools.sendmail -- ( smtp_server => 'your.smtp.server' -- , smtp_server_port => 25 -- , from_name => 'Email Address of Sender' -- , to_name => 'list of TO email addresses separated by commas (,)' -- , cc_name => 'list of CC email addresses separated by commas (,)' -- , bcc_name => 'list of BCC email addresses separated by commas (,)' -- , subject => 'Some brief Subject' -- , MESSAGE => 'Your message goes here. Can include HTML code.' -- , priority => '1-5 1 being the highest priority and 3 normal priority' -- , filename => 'your.filename.txt or leave NULL' -- , binaryfile => 'your blob is passed here otherwise leave as EMPTY_BLOB() -- , DEBUG => 'Default is DBMS output otherwise pass a 1 to disable ); -- END; -- PROCEDURE sendmail ( smtp_server VARCHAR2 , smtp_server_port PLS_INTEGER DEFAULT 25 , from_name VARCHAR2 , to_name VARCHAR2 , cc_name VARCHAR2 DEFAULT NULL , bcc_name VARCHAR2 DEFAULT NULL , subject VARCHAR2 , MESSAGE CLOB , priority PLS_INTEGER DEFAULT NULL , filename VARCHAR2 DEFAULT NULL , binaryfile BLOB DEFAULT EMPTY_BLOB ( ) , DEBUG NUMBER DEFAULT 0 ); v_parm_value VARCHAR2 ( 4000 ); lbok BOOLEAN; v_smtp_server VARCHAR2 ( 50 ); v_smtp_server_port NUMBER := 25; crlf VARCHAR2 ( 10 ) := utl_tcp.crlf; conn utl_tcp.connection; p_debug_marker PLS_INTEGER := 0; rc INTEGER; p_from_name VARCHAR2 ( 100 ); p_to_name VARCHAR2 ( 4000 ); p_cc_name VARCHAR2 ( 4000 ); p_bcc_name VARCHAR2 ( 4000 ); p_subject VARCHAR2 ( 150 ); tx_timeout PLS_INTEGER := 240; -- 240 Seconds (4 minutes); -- p_datestring VARCHAR2 ( 100 ) := 'Date: ' || TO_CHAR ( SYSDATE, 'MM/DD/RR HH:MI AM' ) || ' ' || DBTIMEZONE || ' ' || '(GMT' || DBTIMEZONE || ')'; -- Customize the signature that will appear in the email's MIME header. -- Useful for versioning. mailer_id CONSTANT VARCHAR2 ( 256 ) := 'Mailer by Oracle UTL_TCP'; max_base64_line_width CONSTANT PLS_INTEGER := 76 / 4 * 3; END; / CREATE OR REPLACE PACKAGE BODY mail_tools IS PROCEDURE print_output ( p_message IN VARCHAR2 ) IS BEGIN dbms_output.put_line ( SUBSTR ( p_message , 1 , 250 )); IF LENGTH ( p_message ) > 250 THEN dbms_output.put_line ( SUBSTR ( p_message , 251 , 250 )); END IF; IF LENGTH ( p_message ) > 501 THEN dbms_output.put_line ( SUBSTR ( p_message , 501 , 250 )); END IF; IF LENGTH ( p_message ) > 751 THEN dbms_output.put_line ( SUBSTR ( p_message , 751 , 250 )); END IF; EXCEPTION WHEN OTHERS THEN NULL; -- Ignore errors... protect buffer overflow's etc. END print_output; FUNCTION dump_flatfile ( p_query IN VARCHAR2 , p_dir IN VARCHAR2 , p_filename IN VARCHAR2 , p_separator IN VARCHAR2 , p_headers IN BOOLEAN DEFAULT FALSE , p_trailing_separator IN BOOLEAN DEFAULT FALSE , p_max_linesize IN NUMBER DEFAULT 32000 , p_mode IN VARCHAR2 DEFAULT 'w' ) RETURN NUMBER IS l_output utl_file.file_type; l_thecursor INTEGER DEFAULT dbms_sql.open_cursor; l_columnvalue VARCHAR2 ( 4000 ); l_status INTEGER; l_colcnt NUMBER DEFAULT 0; l_cnt NUMBER DEFAULT 0; l_separator VARCHAR2 ( 10 ) DEFAULT ''; l_line LONG; l_desctbl dbms_sql.desc_tab; v_sqlerrm VARCHAR2 ( 32000 ); l_mode CHAR ( 1 ) := 'w'; BEGIN IF p_mode NOT IN ( 'w', 'a' ) THEN l_mode := 'w'; ELSE l_mode := p_mode; END IF; l_output := utl_file.fopen ( p_dir , p_filename , l_mode , p_max_linesize ); dbms_sql.parse ( l_thecursor , p_query , dbms_sql.native ); dbms_sql.describe_columns ( l_thecursor , l_colcnt , l_desctbl ); FOR i IN 1 .. l_colcnt LOOP dbms_sql.define_column ( l_thecursor , i , l_columnvalue , 4000 ); IF ( l_desctbl ( i ).col_type = 2 ) /* number type */ THEN l_desctbl ( i ).col_max_len := l_desctbl ( i ).col_precision + 2; ELSIF ( l_desctbl ( i ).col_type = 12 ) /* date type */ THEN /* length of my date format */ l_desctbl ( i ).col_max_len := 20; ELSIF ( l_desctbl ( i ).col_type = 8 ) /* LONG type */ THEN l_desctbl ( i ).col_max_len := 2000; END IF; IF p_headers THEN utl_file.put ( l_output, l_separator || l_desctbl ( i ).col_name ); l_separator := p_separator; END IF; END LOOP; IF p_trailing_separator THEN utl_file.put ( l_output, l_separator ); END IF; IF p_headers THEN utl_file.new_line ( l_output ); END IF; l_status := dbms_sql.EXECUTE ( l_thecursor ); LOOP EXIT WHEN ( dbms_sql.fetch_rows ( l_thecursor ) <= 0 ); l_line := NULL; l_separator := ''; FOR i IN 1 .. l_colcnt LOOP dbms_sql.COLUMN_VALUE ( l_thecursor , i , l_columnvalue ); IF NVL ( INSTR ( l_columnvalue, ',' ), 0 ) = 0 THEN NULL; ELSE l_columnvalue := '"' || l_columnvalue || '"'; END IF; utl_file.put ( l_output, l_separator || l_columnvalue ); l_separator := p_separator; END LOOP; IF p_trailing_separator THEN utl_file.put ( l_output, l_separator ); END IF; utl_file.new_line ( l_output ); l_cnt := l_cnt + 1; END LOOP; dbms_sql.close_cursor ( l_thecursor ); utl_file.fclose ( l_output ); RETURN l_cnt; EXCEPTION WHEN NO_DATA_FOUND THEN dbms_output.put_line ( 'NO_DATA_FOUND' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.invalid_path THEN dbms_output.put_line ( 'UTL_FILE.INVALID_PATH' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.read_error THEN dbms_output.put_line ( 'UTL_FILE.READ_ERROR' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.write_error THEN dbms_output.put_line ( 'UTL_FILE.WRITE_ERROR' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.invalid_mode THEN dbms_output.put_line ( 'UTL_FILE.INVALID_MODE' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.invalid_filehandle THEN dbms_output.put_line ( 'UTL_FILE.INVALID_FILEHANDLE' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.invalid_operation THEN dbms_output.put_line ( 'UTL_FILE.INVALID_OPERATION' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.internal_error THEN dbms_output.put_line ( 'UTL_FILE.INTERNAL_ERROR' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN utl_file.invalid_maxlinesize THEN dbms_output.put_line ( 'UTL_FILE.INVALID_MAXLINESIZE' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN VALUE_ERROR THEN dbms_output.put_line ( 'UTL_FILE.VALUE_ERROR' ); utl_file.fclose ( l_output ); RETURN l_cnt; WHEN OTHERS THEN hum_do.default_exception ( 'ERROR in dump_csv : ' ); utl_file.fclose ( l_output ); RETURN l_cnt; END dump_flatfile; -- Return the next email address in the list of email addresses, separated -- by either a "," or a ";". The format of mailbox may be in one of these: -- someone@some-domain -- "Someone at some domain" -- Someone at some domain FUNCTION get_mail_address ( addr_list IN OUT VARCHAR2 ) RETURN VARCHAR2 IS addr VARCHAR2 ( 256 ); i PLS_INTEGER; FUNCTION lookup_unquoted_char ( str IN VARCHAR2 , chrs IN VARCHAR2 ) RETURN PLS_INTEGER AS c VARCHAR2 ( 5 ); i PLS_INTEGER; len PLS_INTEGER; inside_quote BOOLEAN; BEGIN inside_quote := FALSE; i := 1; len := LENGTH ( str ); WHILE ( i <= len ) LOOP c := SUBSTR ( str , i , 1 ); IF ( inside_quote ) THEN IF ( c = '"' ) THEN inside_quote := FALSE; ELSIF ( c = '\' ) THEN i := i + 1; -- Skip the quote character END IF; GOTO next_char; END IF; IF ( c = '"' ) THEN inside_quote := TRUE; GOTO next_char; END IF; IF ( INSTR ( chrs, c ) >= 1 ) THEN RETURN i; END IF; <> i := i + 1; END LOOP; RETURN 0; END; BEGIN addr_list := LTRIM ( addr_list ); i := lookup_unquoted_char ( addr_list, ',;' ); IF ( i >= 1 ) THEN addr := SUBSTR ( addr_list , 1 , i - 1 ); addr_list := SUBSTR ( addr_list, i + 1 ); ELSE addr := addr_list; addr_list := ''; END IF; i := lookup_unquoted_char ( addr, '<' ); IF ( i >= 1 ) THEN addr := SUBSTR ( addr, i + 1 ); i := INSTR ( addr, '>' ); IF ( i >= 1 ) THEN addr := SUBSTR ( addr , 1 , i - 1 ); END IF; END IF; RETURN addr; END; FUNCTION smtp_command ( command IN VARCHAR2 , ok IN VARCHAR2 DEFAULT '250' , code OUT VARCHAR2 , DEBUG NUMBER DEFAULT 0 ) RETURN BOOLEAN IS response VARCHAR2 ( 3 ); p_output_message VARCHAR2 ( 255 ); len PLS_INTEGER; PRAGMA AUTONOMOUS_TRANSACTION; BEGIN len := utl_tcp.write_line ( conn, command ); p_output_message := SUBSTR ( utl_tcp.get_line ( conn, TRUE ) , 1 , 255 ); response := SUBSTR ( p_output_message , 1 , 3 ); p_output_message := SUBSTR ( command || ' - ' || p_output_message , 1 , 255 ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; IF ( response <> ok ) THEN code := response; RETURN FALSE; ELSE code := response; RETURN TRUE; END IF; EXCEPTION WHEN OTHERS THEN p_output_message := SQLCODE || ' - ' || SQLERRM; code := p_output_message; RETURN FALSE; END smtp_command; FUNCTION query_server ( smtp_server VARCHAR2 , smtp_server_port PLS_INTEGER DEFAULT 25 , DEBUG NUMBER DEFAULT 0 ) RETURN BOOLEAN IS p_output_message VARCHAR2 ( 255 ); PRAGMA AUTONOMOUS_TRANSACTION; err_noop EXCEPTION; -- SMTP code 250 not received err_server_reject EXCEPTION; -- SMTP code 421 means rejected BEGIN v_smtp_server := smtp_server; v_smtp_server_port := smtp_server_port; -- Open the SMTP connection ... -- ------------------------ conn := utl_tcp.open_connection ( remote_host => v_smtp_server , remote_port => v_smtp_server_port , tx_timeout => tx_timeout ); ----- OPEN SMTP PORT CONNECTION rc := utl_tcp.write_line ( conn, 'HELO ' || v_smtp_server ); -- This will return a 250 OK response if your connection is valid -- Initial handshaking ... -- ------------------- ----- PERFORMS HANDSHAKING WITH SMTP SERVER p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; IF SUBSTR ( p_output_message , 1 , 3 ) = '421' THEN RAISE err_server_reject; END IF; -- NOOP THE SERVER rc := utl_tcp.write_line ( conn, 'NOOP' ); -- This will return a 250 OK response if your connection is valid -- Initial handshaking ... -- ------------------- ----- PERFORMS NOOP WITH SMTP SERVER p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; IF SUBSTR ( p_output_message , 1 , 3 ) <> '250' THEN RAISE err_noop; END IF; rc := utl_tcp.write_line ( conn, 'QUIT' ); ----- ENDS EMAIL TRANSACTION BEGIN FOR i_idx IN 1 .. 100 LOOP p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; END LOOP; EXCEPTION WHEN OTHERS THEN IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; END; utl_tcp.close_connection ( conn ); ----- CLOSE SMTP PORT CONNECTION RETURN TRUE; EXCEPTION WHEN err_server_reject THEN print_output ( 'ERROR -' || ' Server Rejected Connection ::' || ' SERVER_MSG := ' || p_output_message ); RETURN FALSE; WHEN err_noop THEN print_output ( 'ERROR -' || ' NOOP Check Failed ::' || ' SERVER_MSG := ' || p_output_message ); utl_tcp.close_connection ( conn ); ----- CLOSE SMTP PORT CONNECTION RETURN FALSE; END query_server; FUNCTION get_local_binary_data ( p_dir IN VARCHAR2 , p_file IN VARCHAR2 ) RETURN BLOB IS -- -------------------------------------------------------------------------- l_bfile BFILE; l_data BLOB; l_dbdir VARCHAR2 ( 100 ) := p_dir; BEGIN dbms_lob.createtemporary ( lob_loc => l_data , CACHE => TRUE , dur => dbms_lob.CALL ); l_bfile := BFILENAME ( l_dbdir, p_file ); dbms_lob.fileopen ( l_bfile, dbms_lob.file_readonly ); dbms_lob.loadfromfile ( l_data , l_bfile , dbms_lob.getlength ( l_bfile )); dbms_lob.fileclose ( l_bfile ); RETURN l_data; EXCEPTION WHEN OTHERS THEN print_output ( 'Error during GET_LOCAL_BINARY_DATA :: ' || SQLCODE || ' - ' || SQLERRM ); dbms_lob.fileclose ( l_bfile ); RAISE; END get_local_binary_data; ------------------------------------------------------------------------ PROCEDURE attach_base64 ( conn IN OUT NOCOPY utl_tcp.connection , DATA IN BLOB ) IS i PLS_INTEGER; len PLS_INTEGER; l_result PLS_INTEGER; l_buffer RAW ( 32767 ); l_pos INTEGER := 1; l_blob_len INTEGER; l_amount BINARY_INTEGER := 32767; -- req utl_http.req; resp utl_http.resp; pdata RAW ( 200 ); BEGIN -- Split the Base64-encoded attachment into multiple lines -- In writing Base-64 encoded text following the MIME format below, -- the MIME format requires that a long piece of data must be splitted -- into multiple lines and each line of encoded data cannot exceed -- 80 characters, including the new-line characters. Also, when -- splitting the original data into pieces, the length of each chunk -- of data before encoding must be a multiple of 3, except for the -- last chunk. The constant MAX_BASE64_LINE_WIDTH -- (76 / 4 * 3 = 57) is the maximum length (in bytes) of each chunk -- of data before encoding. -- l_blob_len := dbms_lob.getlength ( DATA ); -- -- -- -- WHILE l_pos < l_blob_len LOOP l_amount := max_base64_line_width; dbms_lob.READ ( DATA , l_amount , l_pos , l_buffer ); rc := utl_tcp.write_raw ( conn, utl_encode.base64_encode ( l_buffer )); utl_tcp.FLUSH ( conn ); l_pos := l_pos + max_base64_line_width; rc := utl_tcp.write_line ( conn, crlf ); END LOOP; END attach_base64; PROCEDURE sendmail ( smtp_server VARCHAR2 , smtp_server_port PLS_INTEGER DEFAULT 25 , from_name VARCHAR2 , to_name VARCHAR2 , cc_name VARCHAR2 DEFAULT NULL , bcc_name VARCHAR2 DEFAULT NULL , subject VARCHAR2 , MESSAGE CLOB , priority PLS_INTEGER DEFAULT NULL , filename VARCHAR2 DEFAULT NULL , binaryfile BLOB DEFAULT EMPTY_BLOB ( ) , DEBUG NUMBER DEFAULT 0 ) IS -- pos PLS_INTEGER := 1; bytes_o_data CONSTANT PLS_INTEGER := 32767; offset PLS_INTEGER := bytes_o_data; msg_length CONSTANT PLS_INTEGER := dbms_lob.getlength ( MESSAGE ); -- v_line VARCHAR2 ( 32767 ); i BINARY_INTEGER; v_slash_pos NUMBER; my_recipients VARCHAR2 ( 32767 ); p_recipient_count PLS_INTEGER := 0; p_output_message VARCHAR2 ( 2000 ); PRAGMA AUTONOMOUS_TRANSACTION; err_server_reject EXCEPTION; -- SMTP code 421 means rejected err_message_send EXCEPTION; -- SMTP code must be 250 err_end_of_input EXCEPTION; -- Used to signify last line of input retrieved -- -- l_result PLS_INTEGER; l_buffer_b RAW ( 32767 ); l_amount BINARY_INTEGER := 32767; l_pos INTEGER := 1; l_blob_len INTEGER; l_blob BLOB; g_debug BOOLEAN := TRUE; i_base64 PLS_INTEGER; len_base64 PLS_INTEGER; BEGIN v_smtp_server := smtp_server; v_smtp_server_port := smtp_server_port; l_blob := binaryfile; -- Open the SMTP connection ... -- ------------------------ conn := utl_tcp.open_connection ( remote_host => v_smtp_server , remote_port => v_smtp_server_port , tx_timeout => tx_timeout ); ----- OPEN SMTP PORT CONNECTION rc := utl_tcp.write_line ( conn, 'HELO ' || v_smtp_server ); -- Initial handshaking ... -- ------------------- ----- PERFORMS HANDSHAKING WITH SMTP SERVER p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; IF SUBSTR ( p_output_message , 1 , 3 ) = '421' THEN RAISE err_server_reject; ELSE -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); rc := utl_tcp.write_line ( conn, 'MAIL FROM: ' || from_name ); ----- MBOX SENDING THE EMAIL p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); -- rc := UTL_TCP.write_line (conn, 'RCPT TO: ' || to_name); -- Specify recipient(s) of the email. my_recipients := to_name; WHILE ( my_recipients IS NOT NULL ) LOOP BEGIN rc := utl_tcp.write_line ( conn , 'RCPT TO: ' || get_mail_address ( my_recipients )); p_recipient_count := p_recipient_count + 1; END; END LOOP; -- DBMS_OUTPUT.put_line ('RCPT TO: COUNT ' || p_recipient_count); ----- MBOX RECV THE EMAIL p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); -- rc := UTL_TCP.write_line (conn, 'RCPT TO: ' || cc_name); -- Specify cc recipient(s) of the email. my_recipients := cc_name; WHILE ( my_recipients IS NOT NULL ) LOOP BEGIN rc := utl_tcp.write_line ( conn , 'RCPT TO: ' || get_mail_address ( my_recipients )); p_recipient_count := p_recipient_count + 1; END; END LOOP; -- DBMS_OUTPUT.put_line ('RCPT TO: COUNT ' || p_recipient_count); ----- MBOX RECV THE EMAIL p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); -- rc := UTL_TCP.write_line (conn, 'RCPT TO: ' || bcc_name); -- Specify bcc recipient(s) of the email. my_recipients := bcc_name; WHILE ( my_recipients IS NOT NULL ) LOOP BEGIN rc := utl_tcp.write_line ( conn , 'RCPT TO: ' || get_mail_address ( my_recipients )); p_recipient_count := p_recipient_count + 1; END; END LOOP; -- DBMS_OUTPUT.put_line ('RCPT TO: COUNT ' || p_recipient_count); ----- MBOX RECV THE EMAIL p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); rc := utl_tcp.write_line ( conn, 'DATA' ); ----- EMAIL MSG BODY START p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); -- build the start of the mail message ... -- ----------------------------------- rc := utl_tcp.write_line ( conn, p_datestring ); rc := utl_tcp.write_line ( conn, 'From: ' || from_name ); rc := utl_tcp.write_line ( conn, 'Subject: ' || subject ); rc := utl_tcp.write_line ( conn, 'To: ' || to_name ); IF cc_name IS NOT NULL THEN rc := utl_tcp.write_line ( conn, 'Cc: ' || cc_name ); END IF; IF bcc_name IS NOT NULL THEN rc := utl_tcp.write_line ( conn, 'Bcc: ' || bcc_name ); END IF; rc := utl_tcp.write_line ( conn, 'Mime-Version: 1.0' ); -- Set priority: -- High Normal Low -- 1 2 3 4 5 IF ( priority IS NOT NULL ) THEN rc := utl_tcp.write_line ( conn, 'X-Priority: ' || priority ); END IF; rc := utl_tcp.write_line ( conn, 'X-Mailer: ' || mailer_id ); rc := utl_tcp.write_line ( conn , 'Content-Type: multipart/mixed; boundary="=_mixed 0052287A85256E75_="' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn , 'This is a Mime message, which your current mail reader may not' ); rc := utl_tcp.write_line ( conn , 'understand. Parts of the message will appear as text. If the remainder' ); rc := utl_tcp.write_line ( conn , 'appears as random characters in the message body, instead of as' ); rc := utl_tcp.write_line ( conn , 'attachments, then you''ll have to extract these parts and decode them' ); rc := utl_tcp.write_line ( conn, 'manually.' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '--=_mixed 0052287A85256E75_=' ); rc := utl_tcp.write_line ( conn , 'Content-Type: text/html; charset=8859-1' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn , '' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, subject ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); WHILE pos < msg_length LOOP rc := utl_tcp.write_line ( conn , dbms_lob.SUBSTR ( MESSAGE , offset , pos )); pos := pos + offset; offset := LEAST ( bytes_o_data, msg_length - offset ); END LOOP; rc := utl_tcp.write_line ( conn, '

' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, crlf ); -- Append the file BLOB ... -- ---------------- -- If the filename has been supplied ... it will fail if the BLOB is empty IF filename IS NOT NULL THEN BEGIN -- generate the MIME boundary line ... rc := utl_tcp.write_line ( conn, '--=_mixed 0052287A85256E75_=' ); rc := utl_tcp.write_line ( conn , 'Content-Type: application/octet-stream; name="' || filename || '"' ); rc := utl_tcp.write_line ( conn , 'Content-Disposition: attachment; filename="' || filename || '"' ); rc := utl_tcp.write_line ( conn , 'Content-Transfer-Encoding: base64' ); rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '' ); -- and append the file contents to the end of the message ... -- Go get the file and the loop through blob and attach data -- and append the file contents to the end of the message ... attach_base64 ( conn => conn , DATA => l_blob ); EXCEPTION WHEN OTHERS THEN p_output_message := 'Error in attaching file ' || filename || ' :: ' || SQLCODE || ' - ' || SQLERRM; IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; RAISE err_message_send; END; END IF; rc := utl_tcp.write_line ( conn, '' ); -- -- -- -- append the final boundary line ... rc := utl_tcp.write_line ( conn, '' ); rc := utl_tcp.write_line ( conn, '--=_mixed 0052287A85256E75_=--' ); rc := utl_tcp.write_line ( conn, '' ); -- and close the SMTP connection ... rc := utl_tcp.write_line ( conn, '.' ); ----- EMAIL MESSAGE BODY END p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; -- DBMS_OUTPUT.put_line (UTL_TCP.get_line (conn, TRUE)); rc := utl_tcp.write_line ( conn, 'QUIT' ); ----- ENDS EMAIL TRANSACTION p_output_message := utl_tcp.get_line ( conn, TRUE ); -- Capture '.' Message sent dialog IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; BEGIN FOR i_idx IN 1 .. 100 LOOP p_output_message := utl_tcp.get_line ( conn, TRUE ); IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; END LOOP; EXCEPTION WHEN OTHERS THEN IF DEBUG = 1 THEN -- No Output NULL; ELSE -- Then DBMS_OUTPUT messages print_output ( p_output_message ); END IF; END; END IF; -- err_server_reject utl_tcp.close_connection ( conn ); ----- CLOSE SMTP PORT CONNECTION EXCEPTION WHEN err_message_send THEN print_output ( CHR ( 10 ) || CHR ( 10 ) || 'ERROR -' || ' Message was not submitted for delivery' ); print_output ( ' [FROM_NAME := ' || from_name || '] ' ); print_output ( ' [TO_NAME := ' || to_name || '] ' ); print_output ( ' [CC_NAME := ' || cc_name || '] ' ); print_output ( ' [BCC_NAME := ' || bcc_name || '] ' ); print_output ( ' [SUBJECT := ' || subject || '] ' ); print_output ( ' SERVER_MSG := ' || p_output_message ); utl_tcp.close_connection ( conn ); ----- CLOSE SMTP PORT CONNECTION WHEN err_server_reject THEN print_output ( CHR ( 10 ) || CHR ( 10 ) || 'ERROR -' || ' Server Rejected Email' ); print_output ( ' [FROM_NAME := ' || from_name || '] ' ); print_output ( ' [TO_NAME := ' || to_name || '] ' ); print_output ( ' [CC_NAME := ' || cc_name || '] ' ); print_output ( ' [BCC_NAME := ' || bcc_name || '] ' ); print_output ( ' [SUBJECT := ' || subject || '] ' ); print_output ( ' SERVER_MSG := ' || p_output_message ); WHEN OTHERS THEN print_output ( CHR ( 10 ) || CHR ( 10 ) || 'ERROR :: ' || SQLCODE || ' - ' || SQLERRM ); print_output ( ' [FROM_NAME := ' || from_name || '] ' ); print_output ( ' [TO_NAME := ' || to_name || '] ' ); print_output ( ' [CC_NAME := ' || cc_name || '] ' ); print_output ( ' [BCC_NAME := ' || bcc_name || '] ' ); print_output ( ' [SUBJECT := ' || subject || '] ' ); print_output ( ' SERVER_MSG := ' || p_output_message ); END sendmail; END; /