2) Criar o Objeto n_smtp (abaixo o export do objeto)
$PBExportHeader$n_smtp.sru
$PBExportComments$SMTP Email Object
forward
global type n_smtp from n_winsock
end type
type uuid from structure within n_smtp
end type
type systemtime from structure within n_smtp
end type
type time_zone_information from structure within n_smtp
end type
type attachment from structure within n_smtp
end type
type address from structure within n_smtp
end type
end forward
type uuid from structure
unsignedlong data1
integer data2
integer data3
blob data4
end type
type systemtime from structure
integer wyear
integer wmonth
integer wdayofweek
integer wday
integer whour
integer wminute
integer wsecond
integer wmilliseconds
end type
type time_zone_information from structure
long bias
character standardname[32]
systemtime standarddate
long standardbias
character daylightname[32]
systemtime daylightdate
long daylightbias
end type
type attachment from structure
string filename
blob filedata
boolean inline
end type
type address from structure
string email
string name
end type
global type n_smtp from n_winsock
end type
type prototypes
// Windows API Functions
Function long CreateFile ( &
string lpFileName, &
ulong dwDesiredAccess, &
ulong dwShareMode, &
ulong lpSecurityAttributes, &
ulong dwCreationDisposition, &
ulong dwFlagsAndAttributes, &
ulong hTemplateFile &
) Library "kernel32.dll" Alias For "CreateFileW"
Function boolean CloseHandle ( &
long hObject &
) Library "kernel32.dll"
Function boolean ReadFile ( &
long hFile, &
Ref blob lpBuffer, &
ulong nNumberOfBytesToRead, &
Ref ulong lpNumberOfBytesRead, &
ulong lpOverlapped &
) Library "kernel32.dll"
Function long UuidCreate ( &
Ref UUID pId &
) Library "rpcrt4.dll"
Function long UuidToString ( &
Ref UUID Uuid, &
Ref ulong StringUuid &
) Library "rpcrt4.dll" Alias For "UuidToStringW"
Function long RpcStringFree ( &
Ref ulong pString &
) Library "rpcrt4.dll" Alias For "RpcStringFreeW"
Subroutine CopyMemory ( &
Ref string Destination, &
ulong Source, &
long Length &
) Library "kernel32.dll" Alias For "RtlMoveMemory"
Function ulong FindMimeFromData ( &
ulong pBC, &
string pwzUrl, &
blob pBuffer, &
ulong cbSize, &
ulong pwzMimeProposed, &
ulong dwMimeFlags, &
ref ulong ppwzMimeOut, &
ulong dwReserved &
) Library "urlmon.dll"
Function Long GetTimeZoneInformation ( &
Ref TIME_ZONE_INFORMATION lpTimeZoneInformation &
) Library "kernel32.dll"
Subroutine SleepMS ( &
ulong dwMilliseconds &
) Library "kernel32.dll" Alias For "Sleep"
// Cryptlib Functions
Function long cryptInit ( &
) Library "cl32.dll"
Function long cryptEnd ( &
) Library "cl32.dll"
Function long cryptCreateSession ( &
Ref long pSession, &
long cryptUser, &
long SessionType &
) Library "cl32.dll"
Function long cryptDestroySession ( &
long session &
) Library "cl32.dll"
Function long cryptSetAttributeString ( &
long hCrypt, &
long CryptAttType, &
Ref string pBuff, &
long StrLen &
) Library "cl32.dll" alias for "cryptSetAttributeString;Ansi"
Function long cryptSetAttribute ( &
long hCrypt, &
long CryptAttType, &
long value &
) Library "cl32.dll"
Function long cryptPopData ( &
long envelope, &
Ref string pBuff, &
long StrLen, &
Ref long pBytesCopied &
) Library "cl32.dll" alias for "cryptPopData;Ansi"
Function long cryptPushData ( &
long envelope, &
Ref string pBuff, &
long StrLen, &
Ref long pBytesCopied &
) Library "cl32.dll" alias for "cryptPushData;Ansi"
Function long cryptFlushData ( &
long envelope &
) Library "cl32.dll"
end prototypes
type variables
Private:
Constant String CRLF = Char(13) + Char(10)
// Cryptlib constants
Constant Long CRYPT_OK = 0
Constant Long CRYPT_UNUSED = -101
Constant Long CRYPT_SESSION_SSL = 3
Constant Long CRYPT_SESSINFO_ACTIVE = 6001
Constant Long CRYPT_SESSINFO_SERVER_NAME = 6008
Constant Long CRYPT_SESSINFO_SERVER_PORT = 6009
Constant Long SMTP_RESPONSE_TIMEOUT = 5000
ULong iul_socket
Long il_Session
Boolean ib_html = False
Boolean ib_receipt = False
Boolean ib_authenticate = False
Boolean ib_eventlog = False
Boolean ib_jaguarlog = False
Boolean ib_messagebox = False
Boolean ib_logfile = False
UInt iui_port = 25
Integer ii_priority = 3
String is_userid
String is_passwd
String is_server
String is_subject
String is_body
String is_customhdr[]
String is_replyto[]
Address istr_From
Address istr_Address[]
Address istr_CC[]
Address istr_Bcc[]
Attachment istr_Attach[]
end variables
forward prototypes
public subroutine of_setserver (string as_server)
public subroutine of_setsubject (string as_subject)
public subroutine of_setfrom (string as_email, string as_name)
public function integer of_addcc (string as_email)
public function integer of_addaddress (string as_email)
public function boolean of_sendmail ()
public subroutine of_reset ()
public subroutine of_setlogin (string as_userid, string as_passwd)
public subroutine of_setbody (string as_body, boolean ab_html)
public subroutine of_setreceipt (boolean ab_receipt)
public subroutine of_setfrom (string as_email)
public function integer of_addaddress (string as_email, string as_name)
public function integer of_addcc (string as_email, string as_name)
public function integer of_addbcc (string as_email)
public function integer of_addbcc (string as_email, string as_name)
private function string of_generate_guid ()
private function string of_findmimefromdata (string as_filename, ref blob ablob_filedata)
public subroutine of_logerror (integer ai_msglevel, string as_msgtext)
public subroutine of_setlogerror (boolean ab_eventlog, boolean ab_jaguarlog, boolean ab_messagebox)
private function string of_timezoneoffset ()
private function boolean of_readfile (string as_filename, ref blob ablob_data)
public function integer of_addattachment (string as_filename, blob ablob_filedata, boolean ab_inline)
public function integer of_addattachment (string as_filename, boolean ab_inline)
public function integer of_addattachment (string as_filename, blob ablob_filedata)
public function integer of_addattachment (string as_filename)
public subroutine of_setpriority (string as_priority)
public subroutine of_resetall ()
public function integer of_addreplyto (string as_email)
public function integer of_addcustomheader (string as_header)
public function boolean of_send (unsignedlong aul_socket, string as_data)
public function boolean of_recv (unsignedlong aul_socket, ref string as_data)
public subroutine of_setlogfile (boolean ab_logfile)
private subroutine of_logfile (string as_logmsg)
public subroutine of_setport (unsignedinteger aui_port)
public function boolean of_sendmail_stop ()
public function boolean of_sendmail_start ()
public function boolean of_sendmail_msg ()
private function string of_stringfromptr (unsignedlong aul_ptr)
private function string of_dataheader ()
private function string of_databody ()
public function string of_data ()
public function string of_crypterror (long al_retval)
public function boolean of_sendtlsmail ()
public function boolean of_sendtlsmail_start ()
public function boolean of_sendtlsmail_msg ()
public function boolean of_sendtlsmail_stop ()
private function boolean of_sendtlsmsg (string as_cmd, integer ai_okreturn)
private function boolean of_sendmsg (string as_cmd, integer ai_okreturn)
public function integer of_addto (string as_email)
public function integer of_addto (string as_email, string as_name)
public function integer of_addfile (string as_filename)
private function string of_hex (unsignedlong aul_decimal)
private function string of_utf8string (string as_string)
private function boolean of_utf8body (ref string as_string)
end prototypes
public subroutine of_setserver (string as_server);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetServer
//
// PURPOSE: This function is used to set the server name
//
// ARGUMENTS: as_server - Server name
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
is_server = as_server
end subroutine
public subroutine of_setsubject (string as_subject);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetSubject
//
// PURPOSE: This function is used to set the message subject.
//
// ARGUMENTS: as_subject - Subject
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
is_subject = as_subject
end subroutine
public subroutine of_setfrom (string as_email, string as_name);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetFrom
//
// PURPOSE: This function is used to set the sender's email address and name.
//
// ARGUMENTS: as_email - Sender's Email address
// as_name - Sender's Name
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
istr_From.Email = as_email
istr_From.Name = as_name
end subroutine
public function integer of_addcc (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddCC
//
// PURPOSE: This function is used to add a CC email address.
//
// ARGUMENTS: as_email - Email address
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddCC(as_email, "")
end function
public function integer of_addaddress (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAddress
//
// PURPOSE: This function is used to add a primary send to email address.
//
// ARGUMENTS: as_email - Email address
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAddress(as_email, "")
end function
public function boolean of_sendmail ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendMail
//
// PURPOSE: This function is the main process to send the email.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
// start the server session
If Not of_SendMail_Start() Then
Return False
End If
// send the email message
If Not of_SendMail_Msg() Then
Return False
End If
// stop the server session
If Not of_SendMail_Stop() Then
Return False
End If
Return True
end function
public subroutine of_reset ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Reset
//
// PURPOSE: This function is used to reset all the recipient and
// attachment arrays.
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Address lstr_EmptyAddress[]
Attachment lstr_EmptyAttachment[]
istr_Address = lstr_EmptyAddress
istr_CC = lstr_EmptyAddress
istr_Bcc = lstr_EmptyAddress
istr_Attach = lstr_EmptyAttachment
end subroutine
public subroutine of_setlogin (string as_userid, string as_passwd);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetLogin
//
// PURPOSE: This function is used to set the userid and password when the
// SMTP server requires authentication.
//
// ARGUMENTS: as_userid - Server userid
// as_passwd - Server password
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
is_userid = as_userid
is_passwd = as_passwd
ib_authenticate = True
end subroutine
public subroutine of_setbody (string as_body, boolean ab_html);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetBody
//
// PURPOSE: This function is used to set the contents of the message body.
//
// ARGUMENTS: as_cmd - SMTP command to be sent
// ab_html - The text contains HTML
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
is_body = as_body
ib_html = ab_html
end subroutine
public subroutine of_setreceipt (boolean ab_receipt);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetReceipt
//
// PURPOSE: This function is used to set whether return receipt is requested.
//
// ARGUMENTS: ab_receipt - True/False
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
ib_receipt = ab_receipt
end subroutine
public subroutine of_setfrom (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetFrom
//
// PURPOSE: This function is used to set the sender's
// email address.
//
// ARGUMENTS: as_email - Sender's Email address
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
of_SetFrom(as_email, "")
end subroutine
public function integer of_addaddress (string as_email, string as_name);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAddress
//
// PURPOSE: This function is used to add a primary send to
// email address and name.
//
// ARGUMENTS: as_email - Email address
// as_name - Recipient name
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(istr_Address) + 1
istr_Address[li_next].Email = as_email
istr_Address[li_next].Name = as_name
Return li_next
end function
public function integer of_addcc (string as_email, string as_name);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddCC
//
// PURPOSE: This function is used to add a CC email address and name.
//
// ARGUMENTS: as_email - Email address
// as_name - Recipient name
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(istr_CC) + 1
istr_CC[li_next].Email = as_email
istr_CC[li_next].Name = as_name
Return li_next
end function
public function integer of_addbcc (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddBcc
//
// PURPOSE: This function is used to add a Blind CC email address.
//
// ARGUMENTS: as_email - Email address
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddBcc(as_email, "")
end function
public function integer of_addbcc (string as_email, string as_name);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddBcc
//
// PURPOSE: This function is used to add a Blind CC email address and name.
//
// ARGUMENTS: as_email - Email address
// as_name - Recipient name
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(istr_Bcc) + 1
istr_Bcc[li_next].Email = as_email
istr_Bcc[li_next].Name = as_name
Return li_next
end function
private function string of_generate_guid ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Generate_GUID
//
// PURPOSE: This function is used to generate a GUID.
//
// RETURN: GUID string
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
UUID lstr_UUID
Constant Long RPC_S_OK = 0
Constant Long SZ_UUID_LEN = 36
ULong lul_ptrUuid
String ls_Uuid
lstr_UUID.Data4 = Blob(Space(8), EncodingAnsi!)
If UuidCreate(lstr_UUID) = RPC_S_OK Then
If UuidToString(lstr_UUID, lul_ptrUuid) = RPC_S_OK Then
ls_Uuid = Space(SZ_UUID_LEN)
CopyMemory(ls_Uuid, lul_ptrUuid, SZ_UUID_LEN*2)
RpcStringFree(lul_ptrUuid)
ls_Uuid = Upper(ls_Uuid)
End If
End If
Return ls_Uuid
end function
private function string of_findmimefromdata (string as_filename, ref blob ablob_filedata);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_FindMimeFromData
//
// PURPOSE: This function is determines the file MIME type.
//
// ARGUMENTS: as_filename - Filename
// ablob_data - By ref blob of the file contents
//
// RETURN: MIME Type
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Constant ulong E_INVALIDARG = 2147942487 // &h80070057
Constant ulong E_OUTOFMEMORY = 2147942414 // &h8007000E
Constant ulong NOERROR = 0
String ls_mimetype, ls_errmsg
ULong lul_ptr, lul_rtn
lul_rtn = FindMimeFromData(0, as_filename, ablob_filedata, Len(ablob_filedata), 0, 0, lul_ptr, 0)
If lul_rtn = NOERROR Then
ls_mimetype = of_StringFromPtr(lul_ptr)
Else
choose case lul_rtn
case E_INVALIDARG
ls_errmsg = "One or more of the arguments passed to the function were invalid."
case E_OUTOFMEMORY
ls_errmsg = "The function could not allocate enough memory to complete the call."
case else
ls_errmsg = "Undefined Error " + String(lul_rtn)
end choose
of_SetLastError("of_FindMimeFromData: " + ls_errmsg)
of_LogError(iERROR, "of_FindMimeFromData: " + ls_errmsg)
SetNull(ls_mimetype)
End If
Return ls_mimetype
end function
public subroutine of_logerror (integer ai_msglevel, string as_msgtext);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_LogError
//
// PURPOSE: This function writes a message to the selected destinations.
//
// ARGUMENTS: ai_msglevel - The level of message importance
// as_msgtext - The text of the message
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
If ib_eventlog Then
this.of_EventLog(ai_msglevel, as_msgtext)
End If
If ib_jaguarlog Then
this.of_JaguarLog(ai_msglevel, as_msgtext)
End If
If ib_messagebox Then
this.of_MessageBox(ai_msglevel, as_msgtext)
End If
end subroutine
public subroutine of_setlogerror (boolean ab_eventlog, boolean ab_jaguarlog, boolean ab_messagebox);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetLogError
//
// PURPOSE: This function is used to set how messages are logged.
//
// ARGUMENTS: ab_eventlog - Write error messages to the Event Log
// ab_jaguarlog - Write error messages to the Jaguar Log
// ab_messagebox - Display error messages with MessageBox
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
ib_eventlog = ab_eventlog
ib_jaguarlog = ab_jaguarlog
ib_messagebox = ab_messagebox
end subroutine
private function string of_timezoneoffset ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_TimeZoneOffset
//
// PURPOSE: This function returns the timezone offset string.
//
// RETURN: Offset
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
TIME_ZONE_INFORMATION lstr_tzi
Integer li_hour, li_minute
Long ll_rtn, ll_bias
String ls_offset
ll_rtn = GetTimeZoneInformation(lstr_tzi)
If ll_rtn = 2 Then
ll_bias = lstr_tzi.Bias + lstr_tzi.DaylightBias
Else
ll_bias = lstr_tzi.Bias
End If
li_hour = Abs(ll_bias) / 60
li_minute = Abs(ll_bias) - (li_hour * 60)
ls_offset = String(li_hour, "00") + String(li_minute, "00")
If ll_bias < 0 Then
ls_offset = "+" + ls_offset
Else
ls_offset = "-" + ls_offset
End If
Return ls_offset
end function
private function boolean of_readfile (string as_filename, ref blob ablob_data);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_ReadFile
//
// PURPOSE: This function is used to read an attachment from disk to a blob.
//
// ARGUMENTS: as_filename - Filename
// ablob_data - By ref blob to receive the file contents
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
// constants for CreateFile API function
Constant Long INVALID_HANDLE_VALUE = -1
Constant ULong GENERIC_READ = 2147483648
Constant ULong GENERIC_WRITE = 1073741824
Constant ULong FILE_SHARE_READ = 1
Constant ULong FILE_SHARE_WRITE = 2
Constant ULong CREATE_NEW = 1
Constant ULong CREATE_ALWAYS = 2
Constant ULong OPEN_EXISTING = 3
Constant ULong OPEN_ALWAYS = 4
Constant ULong TRUNCATE_EXISTING = 5
ULong lul_bytes, lul_length
Long ll_hFile
Blob lblob_filedata
Boolean lb_result
// get file length
lul_length = FileLength(as_filename)
// open file for read
ll_hFile = CreateFile(as_filename, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0)
If ll_hFile = INVALID_HANDLE_VALUE Then
Return False
End If
// read the entire file contents in one shot
lblob_filedata = Blob(Space(lul_length), EncodingAnsi!)
lb_result = ReadFile(ll_hFile, lblob_filedata, lul_length, lul_bytes, 0)
ablob_data = BlobMid(lblob_filedata, 1, lul_length)
// close the file
CloseHandle(ll_hFile)
Return lb_result
end function
public function integer of_addattachment (string as_filename, blob ablob_filedata, boolean ab_inline);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAttachment
//
// PURPOSE: This function is used to add an attachment.
//
// ARGUMENTS: as_filename - Filename of the attachment
// ablob_filedata - Blob containing the attachment
// ab_inline - Content Disposition:
// True=inline, False=attachment
//
// USAGE NOTE: To embed attached images within the HTML email body, use the
// following HTML tag:
//
// 
//
// In this example, filename is the name of the file without the
// path. The file 'C:\My Documents\image.jpg' would be tagged:
//
// 
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(istr_Attach) + 1
istr_Attach[li_next].FileName = as_filename
istr_Attach[li_next].FileData = ablob_filedata
istr_Attach[li_next].Inline = ab_inline
Return li_next
end function
public function integer of_addattachment (string as_filename, boolean ab_inline);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAttachment
//
// PURPOSE: This function is used to add an attachment.
//
// ARGUMENTS: as_filename - Filename of the attachment
// ab_inline - Content Disposition:
// True=inline, False=attachment
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Blob lblob_filedata
String ls_filename
If this.of_ReadFile(as_filename, lblob_filedata) Then
ls_filename = Mid(as_filename, LastPos(as_filename, "\") + 1)
Return of_AddAttachment(ls_filename, lblob_filedata, ab_inline)
Else
Return 0
End If
end function
public function integer of_addattachment (string as_filename, blob ablob_filedata);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAttachment
//
// PURPOSE: This function is used to add an attachment.
//
// ARGUMENTS: as_filename - Filename of the attachment
// ablob_filedata - Blob containing the attachment
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAttachment(as_filename, ablob_filedata, False)
end function
public function integer of_addattachment (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddAttachment
//
// PURPOSE: This function is used to add an attachment.
//
// ARGUMENTS: as_filename - Filename of the attachment
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAttachment(as_filename, False)
end function
public subroutine of_setpriority (string as_priority);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetPriority
//
// PURPOSE: This function is used to set the message priority.
//
// ARGUMENTS: as_priority - Server port
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
choose case Lower(as_priority)
case "high"
ii_priority = 1
case "low"
ii_priority = 5
case else
// Normal
ii_priority = 3
end choose
end subroutine
public subroutine of_resetall ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_ResetAll
//
// PURPOSE: This function is used to reset all settings.
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Address lstr_EmptyAddress
String ls_empty[]
ib_html = False
ib_receipt = False
ib_authenticate = False
ib_eventlog = False
ib_jaguarlog = False
ib_messagebox = False
iui_port = 25
ii_priority = 3
is_userid = ""
is_passwd = ""
is_server = ""
is_subject = ""
is_body = ""
is_customhdr = ls_empty
is_replyto = ls_empty
istr_From = lstr_EmptyAddress
of_Reset()
end subroutine
public function integer of_addreplyto (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddReplyTo
//
// PURPOSE: This function is used to add additional Reply-To email addresses.
//
// ARGUMENTS: as_email - Email address
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// 09/13/2010 RolandS Changed Reply-To to email address only
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(is_replyto) + 1
is_replyto[li_next] = as_email
Return li_next
end function
public function integer of_addcustomheader (string as_header);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddCustomerHeader
//
// PURPOSE: This function is used to add custom header properties.
//
// ARGUMENTS: as_header - Custom header text
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_next
li_next = UpperBound(is_customhdr) + 1
is_customhdr[li_next] = as_header
Return li_next
end function
public function boolean of_send (unsignedlong aul_socket, string as_data);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Send
//
// PURPOSE: This override of the ancestor adds optional logging.
//
// ARGUMENTS: aul_socket - Open socket
// as_data - By ref string
//
// RETURN: True = Success
// False = Error
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/10/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
of_LogFile(as_data)
Return Super::of_Send(aul_socket, as_data)
end function
public function boolean of_recv (unsignedlong aul_socket, ref string as_data);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Recv
//
// PURPOSE: This override of the ancestor adds optional logging.
//
// ARGUMENTS: aul_socket - Open socket
// as_data - By ref string
//
// RETURN: True = Success
// False = Error
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/10/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Boolean lb_return
lb_return = Super::of_Recv(aul_socket, as_data)
of_LogFile(as_data)
Return lb_return
end function
public subroutine of_setlogfile (boolean ab_logfile);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetLogFile
//
// PURPOSE: This function is used to turn on SMTP conversation logging.
//
// ARGUMENTS: ab_logfile - True/False
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/10/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
ib_logfile = ab_logfile
end subroutine
private subroutine of_logfile (string as_logmsg);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_LogFile
//
// PURPOSE: This function writes messages to the SMTP logfile.
//
// ARGUMENTS: as_logmsg - Message text
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/10/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Integer li_fnum
String ls_filename = "smtp_logfile.txt"
If ib_logfile Then
li_fnum = FileOpen(ls_filename, LineMode!, Write!, Shared!, Append!)
FileWrite(li_fnum, as_logmsg)
FileClose(li_fnum)
End If
end subroutine
public subroutine of_setport (unsignedinteger aui_port);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SetPort
//
// PURPOSE: This function is used to set the port the server is using.
// The default is 25 and usually does not need to change.
//
// ARGUMENTS: aui_port - Server port
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
iui_port = aui_port
end subroutine
public function boolean of_sendmail_stop ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendMail_Stop
//
// PURPOSE: This function ends the sendmail session.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_reply, ls_msg
DateTime ldt_current
// quit the server session
ls_msg = "QUIT" + CRLF
If Not of_Send(iul_socket, ls_msg) Then
of_Close(iul_socket)
Return False
End If
// receive response
of_Recv(iul_socket, ls_reply)
// close the socket
of_Close(iul_socket)
// log end of SMTP conversation
ldt_current = DateTime(Today(), Now())
of_LogFile("of_SendMail End: " + String(ldt_current))
Return True
end function
public function boolean of_sendmail_start ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendMail_Start
//
// PURPOSE: This function starts the sendmail session.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Constant String REPLY_READY = "220"
String ls_reply, ls_msg
DateTime ldt_current
// log start of SMTP conversation
ldt_current = DateTime(Today(), Now())
of_LogFile("~r~nof_SendMail Start: " + String(ldt_current) + "~r~n")
// SMTP is Ansi
of_SetUnicode(False, False)
// initialize Winsock
of_Startup()
// connect to server
iul_socket = of_Connect(is_server, iui_port)
If iul_socket = 0 Then Return False
// receive response
of_Recv(iul_socket, ls_reply)
If Left(ls_reply, 3) <> REPLY_READY Then
of_SetLastError(ls_reply)
of_LogError(iERROR, ls_reply)
Return False
End If
// start conversation with server
If ib_authenticate Then
If Not of_SendMsg("EHLO " + of_GetHostName() + CRLF, 250) Then
of_Close(iul_socket)
Return False
End If
If Not of_SendMsg("AUTH LOGIN" + CRLF, 334) Then
of_Close(iul_socket)
Return False
End If
If Not of_SendMsg(of_Encode64(is_userid) + CRLF, 334) Then
of_Close(iul_socket)
Return False
End If
If Not of_SendMsg(of_Encode64(is_passwd) + CRLF, 235) Then
of_Close(iul_socket)
Return False
End If
Else
ls_msg = "HELO " + of_GetHostName() + CRLF
If Not of_SendMsg(ls_msg, 250) Then
of_Close(iul_socket)
Return False
End If
End If
Return True
end function
public function boolean of_sendmail_msg ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendMail_Msg
//
// PURPOSE: This function sends the email to the server.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// 09/17/2010 RolandS Split of_Data into of_DataHeader and of_DataBody
// -----------------------------------------------------------------------------
String ls_reply, ls_msg, ls_head, ls_body
Integer li_rc, li_idx, li_max
// build the data string
ls_head = of_DataHeader()
ls_body = of_DataBody()
// from email address
ls_msg = "MAIL FROM:<" + istr_From.Email + ">" + CRLF
If Not of_SendMsg(ls_msg, 250) Then
of_Close(iul_socket)
Return False
End If
// to email address
li_max = UpperBound(istr_Address)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_Address[li_idx].Email + ">" + CRLF
If Not of_SendMsg(ls_msg, 250) Then
of_Close(iul_socket)
Return False
End If
Next
// cc email address
li_max = UpperBound(istr_CC)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_CC[li_idx].Email + ">" + CRLF
If Not of_SendMsg(ls_msg, 250) Then
of_Close(iul_socket)
Return False
End If
Next
// bcc email address
li_max = UpperBound(istr_Bcc)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_Bcc[li_idx].Email + ">" + CRLF
If Not of_SendMsg(ls_msg, 250) Then
of_Close(iul_socket)
Return False
End If
Next
// data header
ls_msg = "DATA" + CRLF
If Not of_SendMsg(ls_msg, 354) Then
of_Close(iul_socket)
Return False
End If
// send data
If Not of_SendMsg(ls_head+ls_body, 250) Then
of_Close(iul_socket)
Return False
End If
Return True
end function
private function string of_stringfromptr (unsignedlong aul_ptr);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_StringFromPtr
//
// PURPOSE: This function returns a string from a memory pointer.
//
// ARGUMENTS: aul_ptr - Pointer to a string
//
// RETURN: String
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return String(aul_ptr, "address")
end function
private function string of_dataheader ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_DataHeader
//
// PURPOSE: This function is used to build the header section of the DATA
// portion of the message. It is called by of_SendMail_Msg.
//
// RETURN: A string containing the data to send.
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/17/2010 RolandS Initial coding
// 12/26/2010 RolandS Added call to of_UTF8String to encode strings
// as quoted printable for characters > Ascii 127
// -----------------------------------------------------------------------------
String ls_data
Integer li_idx, li_max
DateTime ldt_current
// From address
ls_data += 'From: '
If istr_From.Name <> "" Then
ls_data += of_UTF8String(istr_From.Name) + ' '
End If
ls_data += '<' + istr_From.Email + '>' + CRLF
// To addresses
li_max = UpperBound(istr_Address)
For li_idx = 1 To li_max
If li_idx = 1 Then
ls_data += 'To: '
Else
ls_data += '~t'
End If
If istr_Address[li_idx].Name <> "" Then
ls_data += of_UTF8String(istr_Address[li_idx].Name) + ' '
End If
ls_data += '<' + istr_Address[li_idx].Email + '>'
If li_idx < li_max Then
ls_data += ','
End If
ls_data += CRLF
Next
// CC addresses
li_max = UpperBound(istr_CC)
For li_idx = 1 To li_max
If li_idx = 1 Then
ls_data += 'Cc: '
Else
ls_data += '~t'
End If
If istr_CC[li_idx].Name <> "" Then
ls_data += of_UTF8String(istr_CC[li_idx].Name) + ' '
End If
ls_data += '<' + istr_CC[li_idx].Email + '>'
If li_idx < li_max Then
ls_data += ','
End If
ls_data += CRLF
Next
// Reply-To
li_max = UpperBound(is_replyto)
If li_max = 0 Then
ls_data += 'Reply-To: <' + istr_From.Email + '>' + CRLF
Else
ls_data += 'Reply-To: <' + istr_From.Email + '>,' + CRLF
For li_idx = 1 To li_max
ls_data += '~t'
ls_data += '<' + is_replyto[li_idx] + '>'
If li_idx < li_max Then
ls_data += ','
End If
ls_data += CRLF
Next
End If
// Return Receipt
If ib_receipt Then
ls_data += 'Disposition-Notification-To: '
If istr_From.Name <> "" Then
ls_data += of_UTF8String(istr_From.Name) + ' '
End If
ls_data += '<' + istr_From.Email + '>' + CRLF
End If
// various properties
ls_data += "Subject: " + of_UTF8String(is_subject) + CRLF
ldt_current = DateTime(Today(), Now())
ls_data += "Date: " + String(ldt_current, "ddd, dd mmm yyyy hh:mm:ss")
ls_data += " " + of_TimeZoneOffset() + CRLF
ls_data += 'MIME-Version: 1.0' + CRLF
ls_data += 'X-Mailer: TopWiz PowerBuilder SMTP Object' + CRLF
ls_data += "Return-Path: " + istr_From.Email + CRLF
// Priority
choose case ii_priority
case 1
ls_data += 'X-Priority: 1' + CRLF
ls_data += 'X-MSMail-Priority: High' + CRLF
case 5
ls_data += 'X-Priority: 5' + CRLF
ls_data += 'X-MSMail-Priority: Low' + CRLF
case else
ls_data += 'X-Priority: 3' + CRLF
ls_data += 'X-MSMail-Priority: Normal' + CRLF
end choose
// Custom Headers
li_max = UpperBound(is_customhdr)
For li_idx = 1 To li_max
ls_data += is_customhdr[li_idx] + CRLF
Next
Return ls_data
end function
private function string of_databody ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_DataBody
//
// PURPOSE: This function is used to build the body section of the DATA
// portion of the message. It is called by of_SendMail_Msg.
//
// RETURN: A string containing the data to send.
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/17/2010 RolandS Initial coding
// 12/26/2010 RolandS Added call to of_UTF8Body to encode the body
// as quoted printable for characters > Ascii 127
// -----------------------------------------------------------------------------
String ls_guid, ls_boundary, ls_altboundary
String ls_data, ls_mimetype, ls_contdisp, ls_encoded
Integer li_idx, li_max
DateTime ldt_current
// create boundaries
ls_guid = of_Generate_GUID()
ls_boundary = "000_" + ls_guid
ls_altboundary = "alt_" + ls_guid
// attachment header
If UpperBound(istr_Attach) > 0 Then
If Pos(Lower(is_body), "cid:attach.") > 0 Then
ls_data += 'Content-Type: multipart/related;' + CRLF
Else
ls_data += 'Content-Type: multipart/mixed;' + CRLF
End If
ls_data += ' boundary="' + ls_boundary + '"' + CRLF
ls_data += CRLF
ls_data += 'This is a multi-part message in MIME format.' + CRLF
ls_data += '--' + ls_boundary + CRLF
End If
// add the Body as text or html
If ib_html Then
ls_data += 'Content-Type: text/html;' + CRLF
ls_data += '~tcharset="iso-8859-1"' + CRLF
Else
ls_data += 'Content-Type: text/plain;' + CRLF
ls_data += '~tcharset="iso-8859-1";format=flowed' + CRLF
End If
If of_UTF8Body(is_body) Then
ls_data += 'Content-Transfer-Encoding: quoted-printable' + CRLF
Else
ls_data += 'Content-Transfer-Encoding: 7bit' + CRLF
End If
ls_data += CRLF + is_body + CRLF
// add attachments
If UpperBound(istr_Attach) > 0 Then
li_max = UpperBound(istr_Attach)
For li_idx = 1 To li_max
// add Boundary
ls_data += CRLF + '--' + ls_boundary + CRLF
// determine Content-Type
ls_mimetype = this.of_FindMimeFromData(istr_Attach[li_idx].FileName, &
istr_Attach[li_idx].FileData)
ls_data += 'Content-Type: ' + ls_mimetype + ';' + CRLF
ls_data += ' name="' + istr_Attach[li_idx].FileName + '"' + CRLF
// determine Content-Disposition
If istr_Attach[li_idx].Inline Then
ls_contdisp = 'Content-Disposition: inline;'
Else
ls_contdisp = 'Content-Disposition: attachment;'
End If
// add attachment header and data
If Lower(Left(ls_mimetype, 4)) = "text" Then
ls_data += 'Content-Transfer-Encoding: 7bit' + CRLF
ls_data += ls_contdisp + CRLF
ls_data += ' filename="' + istr_Attach[li_idx].FileName + '"' + CRLF
ls_data += 'Content-ID: ' + CRLF ls_data += CRLF + String(istr_Attach[li_idx].FileData, EncodingAnsi!)
Else
ls_data += 'Content-Transfer-Encoding: base64' + CRLF
ls_data += ls_contdisp + CRLF
ls_data += ' filename="' + istr_Attach[li_idx].FileName + '"' + CRLF
ls_data += 'Content-ID: ' + CRLF // encode the binary data
ls_encoded = this.of_Encode64(istr_Attach[li_idx].FileData)
ls_data += CRLF + ls_encoded + CRLF
End If
Next
ls_data += '--' + ls_boundary + '--'
End If
// final double CRLF
ls_data += CRLF + '.' + CRLF
Return ls_data
end function
public function string of_data ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Data
//
// PURPOSE: This function is for testing purposes only.
//
// RETURN: The DATA section of the email
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/17/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_head, ls_body
// build the data string
ls_head = of_DataHeader()
ls_body = of_DataBody()
Return ls_head+ls_body
end function
public function string of_crypterror (long al_retval);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_CryptError
//
// PURPOSE: This function returns message text for Cryptlib errors.
//
// ARGUMENTS: al_retval - The error returned by a Cryptlib function
//
// RETURN: Error message
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_Return
If al_RetVal = CRYPT_OK Then
Return ""
End If
choose case al_RetVal
// Errors in function calls
case -1
ls_Return = "Bad argument - parameter 1"
case -2
ls_Return = "Bad argument - parameter 2"
case -3
ls_Return = "Bad argument - parameter 3"
case -4
ls_Return = "Bad argument - parameter 4"
case -5
ls_Return = "Bad argument - parameter 5"
case -6
ls_Return = "Bad argument - parameter 6"
case -7
ls_Return = "Bad argument - parameter 7"
// Errors due to insufficient resources
case -10
ls_Return = "Out of memory"
case -11
ls_Return = "Data has not been initialised"
case -12
ls_Return = "Data has already been init'd"
case -13
ls_Return = "Operation not avail at requested sec level"
case -14
ls_Return = "No reliable random data available"
case -15
ls_Return = "Operation failed"
case -16
ls_Return = "Internal consistency check failed"
// Security violations
case -20
ls_Return = "This type of operation not available"
case -21
ls_Return = "No permission to perform this operation"
case -22
ls_Return = "Incorrect key used to decrypt data"
case -23
ls_Return = "Operation incomplete/still in progress"
case -24
ls_Return = "Operation complete/can't continue"
case -25
ls_Return = "Operation timed out before completion"
case -26
ls_Return = "Invalid/inconsistent information"
case -27
ls_Return = "Resource destroyed by extnl.event"
// High-level function errors
case -30
ls_Return = "Resources/space exhausted"
case -31
ls_Return = "Not enough data available"
case -32
ls_Return = "Bad/unrecognised data format"
case -33
ls_Return = "Signature/integrity check failed"
// Data access function errors
case -40
ls_Return = "Cannot open object"
case -41
ls_Return = "Cannot read item from object"
case -42
ls_Return = "Cannot write item to object"
case -43
ls_Return = "Requested item not found in object"
case -44
ls_Return = "Item already present in object"
// Data enveloping errors
case -50
ls_Return = "Need resource to proceed"
case else
ls_Return = "Unknown error code!"
end choose
Return ls_Return
end function
public function boolean of_sendtlsmail ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendTLSMail
//
// PURPOSE: This function is the main process to send encrypted email.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
// start the server session
If Not of_SendTLSMail_Start() Then
Return False
End If
// send the email message
If Not of_SendTLSMail_Msg() Then
Return False
End If
// stop the server session
If Not of_SendTLSMail_Stop() Then
Return False
End If
Return True
end function
public function boolean of_sendtlsmail_start ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendTLSMail_Start
//
// PURPOSE: This function starts the encrypted sendmail session.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_reply, ls_msg
DateTime ldt_current
Long ll_RetVal, ll_ReplyBytes
// log start of SMTP conversation
ldt_current = DateTime(Today(), Now())
of_LogFile("~r~nof_SendTLSMail Start: " + String(ldt_current) + "~r~n")
// Initialize the Library
ll_RetVal = cryptInit()
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptInit: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
// Create the session
ll_RetVal = cryptCreateSession(il_Session, CRYPT_UNUSED, CRYPT_SESSION_SSL)
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptCreateSession: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
cryptEnd()
Return False
End If
// Add the server name
ll_RetVal = cryptSetAttributeString(il_Session, &
CRYPT_SESSINFO_SERVER_NAME, is_server, Len(is_server))
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptSetAttributeString: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
cryptEnd()
Return False
End If
// Specify the Port
ll_RetVal = cryptSetAttribute(il_Session, &
CRYPT_SESSINFO_SERVER_PORT, iui_port)
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptSetAttribute: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
cryptEnd()
Return False
End If
// Activate the session
ll_RetVal = cryptSetAttribute(il_Session, CRYPT_SESSINFO_ACTIVE, 1)
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptSetAttribute: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
cryptEnd()
Return False
End If
// Remove any response created by connecting
ls_Reply = Space(256)
ll_RetVal = cryptPopData(il_session, &
ls_Reply, Len(ls_Reply), ll_ReplyBytes)
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptPopData: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
cryptEnd()
Return False
End If
// Login to server
If Not of_SendTLSMsg("EHLO " + of_GetHostName() + CRLF, 250) Then
cryptEnd()
Return False
End If
If Not of_SendTLSMsg("AUTH LOGIN" + CRLF, 334) Then
cryptEnd()
Return False
End If
If Not of_SendTLSMsg(of_Encode64(is_userid) + CRLF, 334) Then
cryptEnd()
Return False
End If
If Not of_SendTLSMsg(of_Encode64(is_passwd) + CRLF, 235) Then
cryptEnd()
Return False
End If
Return True
end function
public function boolean of_sendtlsmail_msg ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendTLSMail_Msg
//
// PURPOSE: This function sends the encrypted email to the server.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_head, ls_body, ls_msg
Integer li_idx, li_max
// build the data string
ls_head = of_DataHeader()
ls_body = of_DataBody()
// from email address
ls_msg = "MAIL FROM:<" + istr_From.Email + ">" + CRLF
If Not of_SendTLSMsg(ls_msg, 250) Then
cryptEnd()
Return False
End If
// to email address
li_max = UpperBound(istr_Address)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_Address[li_idx].Email + ">" + CRLF
If Not of_SendTLSMsg(ls_msg, 250) Then
cryptEnd()
Return False
End If
Next
// cc email address
li_max = UpperBound(istr_CC)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_CC[li_idx].Email + ">" + CRLF
If Not of_SendTLSMsg(ls_msg, 250) Then
cryptEnd()
Return False
End If
Next
// bcc email address
li_max = UpperBound(istr_Bcc)
For li_idx = 1 To li_max
ls_msg = "RCPT TO:<" + istr_Bcc[li_idx].Email + ">" + CRLF
If Not of_SendTLSMsg(ls_msg, 250) Then
cryptEnd()
Return False
End If
Next
// data header
ls_msg = "DATA" + CRLF
If Not of_SendTLSMsg(ls_msg, 354) Then
cryptEnd()
Return False
End If
// send data
If Not of_SendTLSMsg(ls_head+ls_body, 250) Then
cryptEnd()
Return False
End If
Return True
end function
public function boolean of_sendtlsmail_stop ();// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendTLSMail_Stop
//
// PURPOSE: This function ends the encrypted sendmail session.
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_reply, ls_msg
DateTime ldt_current
// quit the server session
If Not of_SendTLSMsg("QUIT" + CRLF, 221) Then
cryptEnd()
Return False
End If
// Close the session
cryptDestroySession(il_Session)
// Close the Library
cryptEnd()
// log end of SMTP conversation
ldt_current = DateTime(Today(), Now())
of_LogFile("of_SendTLSMail End: " + String(ldt_current))
Return True
end function
private function boolean of_sendtlsmsg (string as_cmd, integer ai_okreturn);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendTLSMsg
//
// PURPOSE: This function is used by other TLS functions to send an
// encrypted message and receive any reply.
//
// ARGUMENTS: as_cmd - SMTP command to be sent
// ai_okreturn - The return code that represents success
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/21/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_reply, ls_msg, ls_Buffer
Long ll_RetVal, ll_ReplyBytes, ll_SentBytes, ll_Totms, ll_Last
// trap unexpected returns
ls_Reply = Space(256)
ll_RetVal = cryptPopData(il_session, &
ls_Reply, Len(ls_Reply), ll_ReplyBytes)
IF ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptPopData: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
ElseIf ll_ReplyBytes > 0 Then
ls_msg = "Unexpected bytes in buffer: " + ls_Reply
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
// Push data
ll_RetVal = cryptPushData(il_session, as_cmd, Len(as_cmd), ll_SentBytes)
If ll_RetVal <> CRYPT_OK Then
ls_msg = "CryptPushData: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
If Len(as_cmd) <> ll_SentBytes Then
ls_msg = String(ll_SentBytes) + " bytes sent, " + String(Len(as_cmd)) + " expected."
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
// Flush outgoing data
ll_RetVal = cryptFlushData(il_session)
If ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptFlushData: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
// Recover response
ls_Reply = ""
ll_Totms = 0
do while True
SleepMS(20)
ll_Totms = ll_Totms + 20
If ll_Totms > SMTP_RESPONSE_TIMEOUT Then
ls_msg = "Response timeout reached: " + String(SMTP_RESPONSE_TIMEOUT) + "ms"
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
ls_Buffer = Space(256)
ll_RetVal = cryptPopData(il_session, ls_Buffer, Len(ls_Buffer), ll_ReplyBytes)
If ll_RetVal <> CRYPT_OK Then
ls_msg = "cryptPopData: " + of_CryptError(ll_RetVal)
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
If ll_ReplyBytes > 0 Then
ls_Reply += Left(ls_Buffer, ll_ReplyBytes)
ll_Last = Len(ls_Reply)
If ll_Last > 7 And Right(ls_Reply, 2) = CRLF Then
If Pos(ls_Reply, Left(ls_Reply, 3) + " ") > 0 Then
If Integer(Left(ls_Reply, 3)) = ai_OkReturn Then
Return True
Else
ls_msg = "Command failed: " + ls_Reply
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
Return False
End If
End If
End If
End If
loop
Return True
end function
private function boolean of_sendmsg (string as_cmd, integer ai_okreturn);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_SendMsg
//
// PURPOSE: This function is used by other functions to send a message and
// receive any reply.
//
// ARGUMENTS: as_cmd - SMTP command to be sent
// ai_okreturn - The return code that represents success
//
// RETURN: True = Success, False = Failure
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 09/08/2010 RolandS Initial coding
// 10/05/2010 RolandS Added the ai_okreturn argument
// -----------------------------------------------------------------------------
String ls_reply, ls_msg
// send the data
If Not of_Send(iul_socket, as_cmd) Then
Return False
End If
// receive response
of_Recv(iul_socket, ls_reply)
If Integer(Left(ls_Reply, 3)) = ai_OkReturn Then
Return True
Else
ls_msg = "Command failed: " + ls_Reply
of_SetLastError(ls_msg)
of_LogError(iERROR, ls_msg)
End If
Return False
end function
public function integer of_addto (string as_email);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddTo
//
// PURPOSE: This function is used to add a primary send to email address.
//
// It had been renamed to of_AddAddress but due to user request,
// this override has been added to allow use of the old name.
//
// ARGUMENTS: as_email - Email address
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 10/12/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAddress(as_email, "")
end function
public function integer of_addto (string as_email, string as_name);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddTo
//
// PURPOSE: This function is used to add a primary send to
// email address and name.
//
// It had been renamed to of_AddAddress but due to user request,
// this override has been added to allow use of the old name.
//
// ARGUMENTS: as_email - Email address
// as_name - Recipient name
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 10/12/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAddress(as_email, as_name)
end function
public function integer of_addfile (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_AddFile
//
// PURPOSE: This function is used to add an attachment.
//
// It had been renamed to of_AddAttachment but due to user request,
// this override has been added to allow use of the old name.
//
// ARGUMENTS: as_filename - Filename of the attachment
//
// RETURN: Index to the array
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 10/12/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
Return of_AddAttachment(as_filename, False)
end function
private function string of_hex (unsignedlong aul_decimal);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_Hex
//
// PURPOSE: This function converts a number to a hex string.
//
// ARGUMENTS: aul_decimal - The number to convert
//
// RETURN: Hex string
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 12/22/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_hex
Char lch_hex[0 to 15] = {'0','1','2','3','4','5','6','7','8','9', 'A','B','C','D','E','F'}
Do
ls_hex = lch_hex[mod(aul_decimal, 16)] + ls_hex
aul_decimal /= 16
Loop Until aul_decimal= 0
Return ls_hex
end function
private function string of_utf8string (string as_string);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_UTF8String
//
// PURPOSE: This function encodes UTF8 strings as quoted printable.
//
// ARGUMENTS: as_string - The string to encode
//
// RETURN: Encoded string
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 12/26/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_char[], ls_result
Integer li_idx, li_max
Boolean lb_utf8
li_max = Len(as_string)
For li_idx = 1 To li_max
ls_char[li_idx] = Mid(as_string, li_idx, 1)
If Asc(ls_char[li_idx]) > 127 Then
lb_utf8 = True
ls_char[li_idx] = "=" + of_Hex(Asc(ls_char[li_idx]))
End If
Next
If lb_utf8 Then
ls_result = "=?iso-8859-1?Q?"
For li_idx = 1 To li_max
If ls_char[li_idx] = " " Then
ls_result += "_"
Else
ls_result += ls_char[li_idx]
End If
Next
ls_result += "?="
Else
ls_result = as_string
End If
Return ls_result
end function
private function boolean of_utf8body (ref string as_string);// -----------------------------------------------------------------------------
// SCRIPT: n_smtp.of_UTF8Body
//
// PURPOSE: This function encodes UTF8 body string as quoted printable.
//
// ARGUMENTS: as_string - The string to encode
//
// RETURN: True=UTF8, False=7bit
//
// DATE PROG/ID DESCRIPTION OF CHANGE / REASON
// ---------- -------- -----------------------------------------------------
// 12/26/2010 RolandS Initial coding
// -----------------------------------------------------------------------------
String ls_char[]
Integer li_idx, li_max
Boolean lb_utf8
li_max = Len(as_string)
For li_idx = 1 To li_max
ls_char[li_idx] = Mid(as_string, li_idx, 1)
If Asc(ls_char[li_idx]) > 127 Then
lb_utf8 = True
ls_char[li_idx] = "=" + of_Hex(Asc(ls_char[li_idx]))
End If
Next
If lb_utf8 Then
as_string = ""
For li_idx = 1 To li_max
choose case ls_char[li_idx]
case "~t" // Tab
as_string += "=09"
case "~n" // LF
as_string += "=0A"
case "~r" // CR
as_string += "=0D"
case " " // Space
as_string += "=20"
case "=" // Equal
as_string += "=3D"
case else
as_string += ls_char[li_idx]
end choose
Next
End If
Return lb_utf8
end function
on n_smtp.create
call super::create
end on
on n_smtp.destroy
call super::destroy
end on
