Files
SISBusiness/SISBusiness.Module/BusinessObjects/SIS/App_Code/SISSMTP.vb
T
2017-03-26 20:00:03 +02:00

234 lines
18 KiB
VB.net

Option Strict On
Option Explicit On
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' SMTP - Copyright 2011 © by David Ross Goben.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Imports System.Net, VB = Microsoft.VisualBasic
'-------------------------------------------------------------------------------
' Class Name : SMTP
' Purpose : SMTP Interface Class
'-------------------------------------------------------------------------------
Public Class SMTP
'*******************************************************************************
' Function Name : BrainDeadSimpleEmailSend
' Purpose : Send super simple email message (works with most SMTP servers)
'===============================================================================
'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus <daviddingus@att.net>
' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
' strSubject: Brief text regarding what the email concerns.
' strBody : text that comprises the message body of the email.
' smtpHost : This is the email host you are using for sending emails, such
' : as "smtp.comcast.net", "authsmtp.juno.com", etc.
'*******************************************************************************
Public Shared Sub BrainDeadSimpleEmailSend(ByVal strFrom As String, _
ByVal strTo As String, _
ByVal strSubject As String, _
ByVal strBody As String, _
ByVal smtpHost As String)
Dim smtpEmail As New Mail.SmtpClient(smtpHost) 'create new SMTP client using TCP Port 25
smtpEmail.Send(strFrom, strTo, strSubject, strBody) 'send email
End Sub
'*******************************************************************************
' Function Name : QuickiEMail
' Purpose : Send a simple email message (but packed with a lot of muscle)
'===============================================================================
'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus <daviddingus@att.net>
' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
' strSubject: Brief text regarding what the email concerns.
' strBody : text that comprises the message body of the email.
' smtpHost : This is the email host you are using for sending emails, such
' : as "smtp.gmail.com", "smtp.comcast.net", "authsmtp.juno.com", etc.
' smtpPort : TCP Communications Port to use. Most servers default to 25.
' usesSLL : If this value is TRUE, then use SSL Authentication protocol for secure communications.
' SSLUsername: If usesSLL is True, this is the username to use for creating a credential. Leave blank if the same as strFrom.
' SSLPassword: If usesSLL is True, this is the password to use for creating a credential. If this field and SSLUsername
' : are blank, then default credentials will be used (only works on local, intranet servers).
' SSLDomain : If creating a credential when a specific domain is required, set this parameter, otherwise, leave it blank.
'*******************************************************************************
Public Shared Function QuickiEMail(ByVal strFrom As String, _
ByVal strTo As String, _
ByVal strSubject As String, _
ByVal strBody As String, _
ByVal smtpHost As String, _
Optional ByVal smtpPort As Integer = 25, _
Optional ByVal usesSSL As Boolean = False, _
Optional ByVal SSLUsername As String = vbNullString, _
Optional ByVal SSLPassword As String = vbNullString, _
Optional ByVal SSLDomain As String = vbNullString) As Boolean
Try
Dim smtpEmail As New Mail.SmtpClient(smtpHost, smtpPort) 'create new SMTP client
smtpEmail.EnableSsl = usesSSL 'true if SSL Authentication required
If usesSSL Then 'SSL authentication required?
If Len(SSLUsername) = 0 AndAlso Len(SSLPassword) = 0 Then 'if both SSLUsername and SSLPassword are blank...
smtpEmail.UseDefaultCredentials = True 'use default credentials
Else 'otherwise, we must create a new credential
If Not CBool(Len(SSLUsername)) Then 'if SSLUsername is blank, use strFrom
smtpEmail.Credentials = New NetworkCredential(strFrom, SSLPassword, SSLDomain)
Else
smtpEmail.Credentials = New NetworkCredential(SSLUsername, SSLPassword, SSLDomain)
End If
End If
End If
smtpEmail.Send(strFrom, strTo, strSubject, strBody) 'send email using text/plain content type and QuotedPrintable encoding
Catch e As Exception 'if error, report it
MsgBox(e.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "Mail Send Error")
Return False 'return a failure flag
End Try
Return True 'if no error, then return a success flag
End Function
'*******************************************************************************
' Function Name : SendEMail
' Purpose : Send a more complex email message
'===============================================================================
'NOTES: strFrom : Full email address of who is sending the email. ie, David Dingus <daviddingus@att.net>
' strTo : Full email address of who to send the email to. ie, "Bubba Dingus" <bob.dingus@cox.com>
' : If multiple recipients, separate each full email address using a semicolon (;)
' strSubject: Brief text regarding what the email concerns.
' strBody : text that comprises the message body of the email. May be raw text or HTML code.
' IsHTML : True if the strBody data is HTML, or the type of data that would be contained within an HTML Body block.
' smtpHost : This is the email host you are using for sending emails, such
' : as "smtp.gmail.com", "smtp.comcast.net", "authsmtp.juno.com", etc.
' AltView : A System.Net.Mail.AlternateView object, such as Rich Text or HTML.
' : If need be, set AltView.ContentType.MediaType and AltView.TransferEncoding to properly format the AlternateView.
' : For example: AltView.ContentType.MediaType = Mime.MediaTypeNames.Text.Rtf
' : AltView.TransferEncoding = Mime.TransferEncoding.SevenBit
' StrCC : Send "carbon copies" of email to this or these recipients.
' : If multiple recipients, separate each full email address using a semicolon (;)
' strBcc : Blind Carbon Copy. Hide this or these recipients from view by others.
' : If multiple recipients, separate each full email address using a semicolon (;)
' strAttachments: A single filepath, or a list of filepaths to send to the recipient.
' : If multiple attachments, separate each filepath using a semicolon (;) (C:\my data\win32.txt; c:\jokes.rtf)
' : The contents of the attachments will be encoded and sent.
' : If you wish to send the attachment by specifying content type (MediaType) and content transfer encoding
' : (Encoding), then follow the attachment name with the MediaType and optional encoding (default is
' : application/octet-stream,Base64) by placing them within parentheses, and separated by a comma. For example:
' : C:\My Files\API32.txt (text/plain, SevenBit); C:\telnet.exe (application/octet-stream, Base64)
' : Where: The MediaType is determined from the System.Net.Mime.MediaTypeNames class, which
' : can specify Application, Image, or Text lists. For example, the above content type,
' : "text\plain", was defined by acquiring System.Net.Mime.MediaTypeNames.Text.Plain.
' : The second parameter, Encoding, is determined by the following the values specified by the
' : System.Net.Mime.TrasperEncoding enumeration:
' : QuotedPrintable (acquired by System.Net.Mime.TransferEncoding.QuotedPrintable.ToString)
' : Base64 (acquired by System.Net.Mime.TransferEncoding.Base64.ToString)
' : SevenBit (acquired by System.Net.Mime.TransferEncoding.SevenBit.ToString)
' smtpPort : TCP Communications Port to use. Most servers default to 25.
' usesSLL : If this value is TRUE, then use SSL Authentication protocol for secure communications.
' SSLUsername: If usesSLL is True, this is the username to use for creating a credential. Leave blank if the same as strFrom.
' SSLPassword: If usesSLL is True, this is the password to use for creating a credential. If this field and SSLUsername
' : are blank, then default credentials will be used (only works on local, intranet servers).
' SSLDomain : If creating a credential when a specific domain is required, set this parameter, otherwise, leave it blank.
'*******************************************************************************
Public Shared Function SendEMail(ByVal strFrom As String, _
ByVal strTo As String, _
ByVal strSubject As String, _
ByVal strBody As String, _
ByVal IsHTML As Boolean, _
ByVal smtpHost As String, _
Optional ByVal AltView As Mail.AlternateView = Nothing, _
Optional ByVal strCC As String = vbNullString, _
Optional ByVal strBcc As String = vbNullString, _
Optional ByVal strAttachments As String = vbNullString, _
Optional ByVal smtpPort As Integer = 25, _
Optional ByVal usesSSL As Boolean = False, _
Optional ByVal SSLUsername As String = vbNullString, _
Optional ByVal SSLPassword As String = vbNullString, _
Optional ByVal SSLDomain As String = vbNullString) As Boolean
Dim Email As New Mail.MailMessage 'create a new mail message
With Email
.From = New Mail.MailAddress(strFrom) 'add FROM to mail message (must be a Mail Address object)
'-------------------------------------------
Dim Ary() As String = Split(strTo, ";") 'add TO to mail message (possible list of email addresses; separated each with ";")
For Idx As Integer = 0 To UBound(Ary)
If Len(Trim(Ary(Idx))) <> 0 Then .To.Add(Trim(Ary(Idx))) 'add each TO recipent (primary recipients)
Next
'-------------------------------------------
.Subject = strSubject 'add SUBJECT text line to mail message
'-------------------------------------------
.Body = strBody 'add BODY text of email to mail message.
.IsBodyHtml = IsHTML 'indicate if the message body is actually HTML text.
.IsBodyHtml = True
'-------------------------------------------
If AltView IsNot Nothing Then 'if an alternate view of plaint text message is defined...
.AlternateViews.Add(AltView) 'add the alternate view
End If
'-------------------------------------------
If CBool(Len(strCC)) Then 'add CC (Carbon Copy) email addresses to mail message
Ary = Split(strCC, ";") '(possible list of email addresses, separated each with ";")
For Idx As Integer = 0 To UBound(Ary)
If Len(Trim(Ary(Idx))) <> 0 Then .CC.Add(Trim(Ary(Idx))) 'add each recipent
Next
End If
'-------------------------------------------
If CBool(Len(strBcc)) Then 'add Bcc (Blind Carbon Copy) email addresses to mail message
Ary = Split(strBcc, ";") '(possible list of email addresses; separated each with ";")
For Idx As Integer = 0 To UBound(Ary)
If Len(Trim(Ary(Idx))) <> 0 Then .Bcc.Add(Trim(Ary(Idx))) 'add each recipent (hidden recipents)
Next
End If
'-------------------------------------------
If CBool(Len(strAttachments)) Then 'add any attachments to mail message
Ary = Split(strAttachments, ";") '(possible list of file paths, separated each with ";")
For Idx As Integer = 0 To UBound(Ary) 'process each attachment
Dim attach As String = Trim(Ary(Idx)) 'get attachment data
If Len(attach) <> 0 Then 'if an attachment present...
Dim I As Integer = InStr(attach, "(") 'check for formatting instructions
If CBool(I) Then 'formatting present?
Dim Fmt As String 'yes, so set up format cache
Fmt = Mid(attach, I + 1, Len(attach) - I - 1) 'get format data
attach = Trim(VB.Left(attach, I - 1)) 'strip format data from the attachment path
Dim Atch As New Mail.Attachment(attach) 'create a new attachment
Dim fmts() As String = Split(Fmt, ",") 'break formatting up
For I = 0 To UBound(fmts) 'process each format specification
Fmt = Trim(fmts(I)) 'grab a format instruction
If CBool(Len(Fmt)) Then 'data defined?
Select Case I 'yes, so determine which type of instruction to process
Case 0 'index 0 specified MediaType
Atch.ContentType.MediaType = Fmt 'set media type to attachment
Case 1 'index 1 specifes Encoding
Select Case LCase(Fmt) 'check the encoding types and process accordingly
Case "quotedprintable", "quoted-printable"
Atch.TransferEncoding = Mime.TransferEncoding.QuotedPrintable
Case "sevenbit", "7bit"
Atch.TransferEncoding = Mime.TransferEncoding.SevenBit
Case Else
Atch.TransferEncoding = Mime.TransferEncoding.Base64
End Select
End Select
End If
Next
.Attachments.Add(Atch) 'add attachment to email
Else
.Attachments.Add(New Mail.Attachment(attach)) 'add filepath (if no format specified, encoded in effiecient Base64)
End If
End If
Next
End If
End With
'-----------------------------------------------------------------------
'now open the email server...
Try
Dim SmtpEmail As New Mail.SmtpClient(smtpHost, smtpPort) 'create new SMTP client on the SMTP server
SmtpEmail.EnableSsl = usesSSL 'true if SSL Authentication required
If usesSSL Then 'SSL authentication required?
If Len(SSLUsername) = 0 AndAlso Len(SSLPassword) = 0 Then 'if both SSLUsername and SSLPassword are blank...
SmtpEmail.UseDefaultCredentials = True 'use default credentials
Else 'otherwise, we must create a new credential
If Not CBool(Len(SSLUsername)) Then 'if SSLUsername is blank, use strFrom
SmtpEmail.Credentials = New NetworkCredential(strFrom, SSLPassword, SSLDomain)
Else
SmtpEmail.Credentials = New NetworkCredential(SSLUsername, SSLPassword, SSLDomain)
End If
End If
End If
SmtpEmail.Send(Email) 'finally, send the email...
Catch e As Exception 'if error, report it
MsgBox(e.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "Mail Error")
Return False 'return failure flag
End Try
Return True 'return success flag
End Function
End Class