terça-feira, janeiro 04, 2011

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

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

Nenhum comentário: