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 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 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 ''' ''' Envía un correo electrónico. Puede recibir adjuntos mediante un Dictionary(Of String, Stream). ''' ''' ''' ''' ''' ''' ''' 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. ''' ''' ''' ''' ''' ''' ''' 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