Blog de Tecnologia desenvolvido por Thiago Campos Pereira: PowerBuilder

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

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

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

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'}

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

Blog de Tecnologia desenvolvido por Thiago Campos Pereira

terça-feira, janeiro 04, 2011

PowerBuilder – Enviando e-mail por SMTP - Parte 2 / 4

Nenhum comentário: