Files
tsUtilidades/Correo.vb

807 lines
41 KiB
VB.net

Option Strict Off
Imports System.IO
Imports System.Net.Mail
Imports System.Net
Imports System.Security.Cryptography.X509Certificates
Imports System.Net.Security
Imports System.Net.Mime
Imports System.IO.Compression
Imports tsUtilidades.Extensiones
Namespace Correo
<Obsolete("Esta clase es Obsoleta. Utilizar la librería tsCorreos.")>
Public Class ConfCuentaCorreo
Property Puerto As Integer
Property SSL As Boolean
Property ServidorSMTP As String
Property CuentaCorreo As String
Property Contraseña As String
Property Remitente As String
End Class
<Obsolete("Esta clase es Obsoleta. Utilizar la librería tsCorreos.")>
Public Class Funciones
Public Shared Sub EnviaCorreoCompruebaHTML(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos() As MemoryStream,
ByVal NombreFicherosAdjuntos() As String,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "")
If FicherosAdjuntos.Count = 1 AndAlso NombreFicherosAdjuntos(0).EndsWith(".html.zip") Then
Dim sDirectorioTMP As String = tsUtilidades.Utilidades.ObtieneDirectorioAleatorio
zip.ExtraeTodoDeZip(FicherosAdjuntos(0), sDirectorioTMP)
' tsZIP.zip.ExtraeTodoDeZip("f:\temp\csc.html.zip", sDirectorioTMP)
Dim sFichCuerpo = IO.Directory.GetFiles(sDirectorioTMP, "*.html")(0)
Dim sCuerpo = System.Text.Encoding.UTF8.GetString(IO.File.ReadAllBytes(sFichCuerpo))
Dim avHtml As AlternateView = AlternateView.CreateAlternateViewFromString(sCuerpo, Nothing, MediaTypeNames.Text.Html)
Dim diradj = IO.Directory.GetDirectories(sDirectorioTMP)(0)
Dim ficadj = IO.Directory.GetFiles(diradj)
For Each f In ficadj
Dim ms As New MemoryStream(IO.File.ReadAllBytes(f))
Dim inline As New LinkedResource(ms, "image/" & IO.Path.GetExtension(f).Trim("."))
inline.ContentId = IO.Path.GetFileNameWithoutExtension(f)
avHtml.LinkedResources.Add(inline)
Next
Dim avs As New List(Of AlternateView)
avs.Add(avHtml)
EnviaCorreoHtml(ServidorSMTP, Remitente, Destinatario, Asunto, Cuerpo, Nothing, avs, CC, BCC, CuentaCorreo, ContraseñaCorreo, Puerto, UsarSSL, True, ResponderA)
IO.Directory.Delete(sDirectorioTMP, True)
Else
EnviaCorreo(ServidorSMTP, Remitente, Destinatario, Asunto, Cuerpo, FicherosAdjuntos, NombreFicherosAdjuntos, CC, BCC, CuentaCorreo, ContraseñaCorreo, Puerto, UsarSSL, CuerpoenHTML, ResponderA)
End If
End Sub
Public Shared Sub EnviaCorreoHtml(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal AttachMents As List(Of Attachment),
ByVal AlternateViews As List(Of AlternateView),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "")
Try
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
For Each scc In CC.Split(";")
myMessage.CC.Add(scc)
Next
End If
If BCC <> "" Then
For Each sbcc In BCC.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If AttachMents IsNot Nothing Then
For Each att In AttachMents
myMessage.Attachments.Add(att)
Next
End If
If AlternateViews IsNot Nothing Then
For Each av In AlternateViews
myMessage.AlternateViews.Add(av)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal AttachMents As List(Of Attachment),
ByVal AlternateViews As List(Of AlternateView),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "", Optional CredencialesConDominio As Boolean = False, Optional ProtocoloSeguridad As SecurityProtocolType = SecurityProtocolType.Tls)
Try
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
If Destinatario.NothingAVacio = "" And CC.NothingAVacio <> "" Then
Destinatario = CC
CC = ""
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage()
myMessage.Subject = Asunto
myMessage.Body = Cuerpo
myMessage.From = New MailAddress(Remitente)
Dim sDestinatarios() As String = Nothing
sDestinatarios = Destinatario.Split(";")
For Each dest In sDestinatarios
dest = dest.Trim
If dest.Trim <> "" Then
myMessage.To.Add(dest)
End If
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
Dim scc = CC.Split(";")
For Each c In scc
If c <> "" Then myMessage.CC.Add(c)
Next
End If
If BCC <> "" Then
Dim sbcc = BCC.Split(";")
For Each b In sbcc
If b <> "" Then myMessage.Bcc.Add(b)
Next
End If
If AttachMents IsNot Nothing Then
For Each att In AttachMents
myMessage.Attachments.Add(att)
Next
End If
If AlternateViews IsNot Nothing Then
For Each av In AlternateViews
myMessage.AlternateViews.Add(av)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
If CredencialesConDominio Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo, CuentaCorreo.Split("@")(1))
Else
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
End If
SmtpMail.EnableSsl = UsarSSL
' SmtpMail.TargetName = "STARTTLS/smtp.office365.com"
' ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls OrElse SecurityProtocolType.Tls11 OrElse SecurityProtocolType.Tls12 OrElse SecurityProtocolType.Tls13
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos() As MemoryStream,
ByVal NombreFicherosAdjuntos() As String,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False, Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "")
Try
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
Destinatario = "danmun@tecnosis.eu"
End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
myMessage.IsBodyHtml = CuerpoenHTML
If CC <> "" Then
For Each scc In CC.Split(";")
myMessage.CC.Add(scc)
Next
End If
If BCC <> "" Then
For Each sbcc In BCC.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
myAttch = New Attachment(FicherosAdjuntos(i), NombreFicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.UseDefaultCredentials = False
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
ByVal FicherosAdjuntos As List(Of String),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False,
Optional CuerpoenHTML As Boolean = False,
Optional ByVal ResponderA As String = "")
Try
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' Destinatario = "danmun@tecnosis.eu"
'End If
Asunto = Asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
myMessage.ReplyToList.Add(New MailAddress(Remitente, Remitente))
End If
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
If CC <> "" Then
myMessage.CC.Add(CC)
End If
If BCC <> "" Then
myMessage.Bcc.Add(BCC)
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(FicherosAdjuntos(i)) Then
myAttch = New Attachment(FicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal destinatarios As List(Of String),
ByVal asunto As String,
ByVal cuerpo As String,
ByVal ficherosAdjuntos As List(Of String),
Optional ByVal cc As String = "",
Optional ByVal bcc As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal cuerpoEsHTML As Boolean = False,
Optional ByVal responderA As String = "")
Try
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
' Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' Destinatario = "danmun@tecnosis.eu"
'End If
asunto = asunto.Replace(Environment.NewLine, " ")
myMessage = New MailMessage
myMessage.Body = cuerpo
myMessage.Subject = asunto
For Each destinatario In destinatarios
myMessage.To.Add(New MailAddress(destinatario, destinatario))
Next
myMessage.BodyEncoding = Text.Encoding.Default
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
myMessage.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
myMessage.ReplyToList.Add(New MailAddress(responderA, responderA))
myMessage.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
myMessage.Sender = New MailAddress(remitente, remitente)
myMessage.From = New MailAddress(remitente, remitente)
If cc <> "" Then
For Each scc In cc.Split(";")
myMessage.CC.Add(scc)
Next
End If
If bcc <> "" Then
For Each sbcc In bcc.Split(";")
myMessage.Bcc.Add(sbcc)
Next
End If
If Not ficherosAdjuntos Is Nothing Then
iCnt = ficherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(ficherosAdjuntos(i)) Then
myAttch = New Attachment(ficherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If servidorSMTP <> "" Then SmtpMail.Host = servidorSMTP
SmtpMail.Port = puerto
If cuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
SmtpMail.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
Public Shared Sub EnviaCorreo(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
Optional ByVal FicherosAdjuntos As ArrayList = Nothing,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False)
Try
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
'myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage = New MailMessage
myMessage.Body = Cuerpo
myMessage.Subject = Asunto
Dim destinatarios = Destinatario.Split(";")
For Each Destinatario In destinatarios
myMessage.To.Add(New MailAddress(Destinatario.Trim, Destinatario.Trim))
Next
myMessage.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, Remitente)
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
If CC <> "" Then
Dim scc = CC.Split(";")
For Each c In scc
If c <> "" Then myMessage.CC.Add(c)
Next
End If
If BCC <> "" Then
Dim sbcc = BCC.Split(";")
For Each b In sbcc
If b <> "" Then myMessage.Bcc.Add(b)
Next
End If
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(FicherosAdjuntos(i)) Then
myAttch = New Attachment(FicherosAdjuntos(i))
myMessage.Attachments.Add(myAttch)
' myAttch.Dispose()
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
' SmtpMail.UseDefaultCredentials = True
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw myexp
End Try
End Sub
Public Shared Sub EnviaCorreoVariosAdjuntos(ByVal ServidorSMTP As String,
ByVal Remitente As String,
ByVal Destinatario As String,
ByVal Asunto As String,
ByVal Cuerpo As String,
Optional ByVal FicherosAdjuntos As List(Of FicheroAdjunto) = Nothing,
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal CuentaCorreo As String = "",
Optional ByVal ContraseñaCorreo As String = "",
Optional ByVal Puerto As Integer = 25,
Optional ByVal UsarSSL As Boolean = False)
Try
Dim myAttch As Attachment
Dim SmtpMail As SmtpClient
Dim myMessage As MailMessage
Dim i, iCnt As Integer
myMessage = New MailMessage(Remitente, Destinatario, Asunto, Cuerpo)
myMessage.BodyEncoding = Text.Encoding.Default
myMessage.ReplyTo = New MailAddress(Remitente, Remitente)
myMessage.Sender = New MailAddress(Remitente, Remitente)
myMessage.From = New MailAddress(Remitente, Remitente)
If CC <> "" Then
myMessage.CC.Add(CC)
End If
If BCC <> "" Then
myMessage.Bcc.Add(BCC)
End If
Dim cd As System.Net.Mime.ContentDisposition
If Not FicherosAdjuntos Is Nothing Then
iCnt = FicherosAdjuntos.Count - 1
For i = 0 To iCnt
If FicherosAdjuntos(i).Ruta <> "" Then
If IO.File.Exists(FicherosAdjuntos(i).Ruta) Then
myAttch = New Attachment(FicherosAdjuntos(i).Ruta)
cd = myAttch.ContentDisposition
cd.FileName = FicherosAdjuntos(i).NombreFichero
myMessage.Attachments.Add(myAttch)
End If
Else
If Not FicherosAdjuntos(i).Fichero Is Nothing AndAlso FicherosAdjuntos(i).Fichero.Length > 0 Then
myAttch = New Attachment(New IO.MemoryStream(FicherosAdjuntos(i).Fichero), FicherosAdjuntos(i).NombreFichero)
cd = myAttch.ContentDisposition
cd.FileName = FicherosAdjuntos(i).NombreFichero
myMessage.Attachments.Add(myAttch)
End If
End If
Next
End If
SmtpMail = New SmtpClient
If ServidorSMTP <> "" Then SmtpMail.Host = ServidorSMTP
SmtpMail.Port = Puerto
If CuentaCorreo <> "" Then
SmtpMail.Credentials = New System.Net.NetworkCredential(CuentaCorreo, ContraseñaCorreo)
End If
SmtpMail.EnableSsl = UsarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
SmtpMail.Send(myMessage)
Catch myexp As Exception
Throw myexp
End Try
End Sub
''' <summary>
''' Envía un correo electrónico. Puede recibir adjuntos mediante un Dictionary(Of String, Stream).
''' </summary>
''' <param name="servidorSMTP"></param>
''' <param name="remitente"></param>
''' <param name="destinatario"></param>
''' <param name="asunto"></param>
''' <param name="cuerpo"></param>
''' <param name="adjuntos">Un Dictionary(Of String, Stream). La clave es el nombre del archivo adjunto, el valor es el contenido del archivo adjunto en forma de Stream.</param>
''' <param name="cc"></param>
''' <param name="bcc"></param>
''' <param name="cuentaCorreo"></param>
''' <param name="contraseñaCorreo"></param>
''' <param name="puerto"></param>
''' <param name="usarSSL"></param>
''' <remarks></remarks>
Public Shared Sub EnviarCorreoElectrónico(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal destinatario As String,
ByVal asunto As String,
ByVal cuerpo As String,
Optional ByVal adjuntos As Dictionary(Of String, Stream) = Nothing,
Optional ByVal cc As String = "",
Optional ByVal bcc As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal ResponderA As String = "")
Try
Dim clienteSMTP As SmtpClient
Dim mensaje As MailMessage
' Si es alguna de las máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then
' destinatario = "danmun@tecnosis.eu"
'End If
asunto = asunto.Replace(Environment.NewLine, " ")
mensaje = New MailMessage(remitente, destinatario, asunto, cuerpo)
mensaje.BodyEncoding = Text.Encoding.Default
If ResponderA Is Nothing OrElse String.IsNullOrWhiteSpace(ResponderA) Then
mensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
mensaje.ReplyToList.Add(New MailAddress(ResponderA, ResponderA))
mensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
mensaje.Sender = New MailAddress(remitente, remitente)
mensaje.From = New MailAddress(remitente, remitente)
If cc <> "" Then
mensaje.CC.Add(cc)
End If
If bcc <> "" Then
mensaje.Bcc.Add(bcc)
End If
If Not adjuntos Is Nothing Then
If adjuntos.Count > 0 Then
For Each adjunto In adjuntos
mensaje.Attachments.Add(New Attachment(adjunto.Value, adjunto.Key))
Next
End If
End If
clienteSMTP = New SmtpClient
If servidorSMTP <> "" Then clienteSMTP.Host = servidorSMTP
clienteSMTP.Port = puerto
If cuentaCorreo <> "" Then
clienteSMTP.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
clienteSMTP.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
clienteSMTP.Send(mensaje)
Catch myexp As Exception
Throw New Exception(myexp.Message, myexp)
End Try
End Sub
Public Shared Sub EnviaCorreoMultiplesDestinatarios(ByVal servidorSMTP As String,
ByVal remitente As String,
ByVal listaDestinatarios As List(Of String),
ByVal asunto As String,
ByVal cuerpo As String,
ByVal ficherosAdjuntos As List(Of String),
Optional ByVal CC As String = "",
Optional ByVal BCC As String = "",
Optional ByVal cuentaCorreo As String = "",
Optional ByVal contraseñaCorreo As String = "",
Optional ByVal puerto As Integer = 25,
Optional ByVal usarSSL As Boolean = False,
Optional ByVal responderA As String = "")
Try
Dim misAdjuntos As Attachment
Dim clienteSMTP As SmtpClient
Dim miMensaje As MailMessage
Dim i, iCnt As Integer
'// Si es alguna de kas máquinas de desarrollo de danmun, el correo se envía solamente a danmun. Son pruebas.
'If Environment.MachineName = "WINXP-PARALLELS" OrElse
' Environment.MachineName = "WINXP-DE-DANIEL" OrElse
' Environment.MachineName.ToUpper = "Win81PDdanmun".ToUpper OrElse
' Environment.MachineName.ToUpper.StartsWith("INTI") Then
' listaDestinatarios = New List(Of String)
' listaDestinatarios.Add("danmun@tecnosis.net")
'End If
For Each destinatario In listaDestinatarios
asunto = asunto.Replace(Environment.NewLine, " ")
miMensaje = New MailMessage(New MailAddress(remitente, remitente), New MailAddress(destinatario, destinatario)) With {
.Subject = asunto,
.Body = cuerpo,
.BodyEncoding = Text.Encoding.UTF8
}
If responderA Is Nothing OrElse String.IsNullOrWhiteSpace(responderA) Then
miMensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
Else
miMensaje.ReplyToList.Add(New MailAddress(responderA, responderA))
miMensaje.ReplyToList.Add(New MailAddress(remitente, remitente))
End If
miMensaje.Sender = New MailAddress(remitente, remitente)
If CC <> "" Then
miMensaje.CC.Add(CC)
End If
If BCC <> "" Then
miMensaje.Bcc.Add(BCC)
End If
If Not ficherosAdjuntos Is Nothing Then
iCnt = ficherosAdjuntos.Count - 1
For i = 0 To iCnt
If IO.File.Exists(ficherosAdjuntos(i)) Then
misAdjuntos = New Attachment(ficherosAdjuntos(i))
miMensaje.Attachments.Add(misAdjuntos)
'misAdjuntos.Dispose()
End If
Next
End If
clienteSMTP = New SmtpClient
If servidorSMTP <> "" Then clienteSMTP.Host = servidorSMTP
clienteSMTP.Port = puerto
If cuentaCorreo <> "" Then
clienteSMTP.Credentials = New System.Net.NetworkCredential(cuentaCorreo, contraseñaCorreo)
End If
clienteSMTP.EnableSsl = usarSSL
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True
clienteSMTP.Send(miMensaje)
System.Threading.Thread.Sleep(1000 * (listaDestinatarios.Count - 1))
Next
Catch e As Exception
Throw New Exception(e.Message, e)
End Try
End Sub
End Class
Public Class FicheroAdjunto
Property Ruta As String
Property NombreFichero As String
Property Fichero As Byte()
End Class
End Namespace