Imports System.Net Imports System.Net.Mail Imports System.Net.Security Imports System.Security.Cryptography.X509Certificates Imports Microsoft.Identity.Client Imports System.Threading.Tasks Imports System.Text Public Class CorreoOAuth2 Public Shared Async Function EnviaCorreoOffice365(ByVal ServidorSMTP As String, ByVal ClientId As String, ByVal TenantId As String, ByVal ClientSecret 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 Puerto As Integer = 587, Optional ByVal UsarSSL As Boolean = True, Optional CuerpoenHTML As Boolean = False, Optional ByVal ResponderA As String = "", Optional NombreRemitente As String = "") As Task Try If NombreRemitente = "" Then NombreRemitente = Remitente ' Validación para entornos de desarrollo If Environment.MachineName = "WIN81PDDANMUN" OrElse Environment.MachineName.ToUpper = "INTI81".ToUpper OrElse Environment.MachineName.ToUpper = "INTI10".ToUpper Then Destinatario = "danmun@tecnosis.eu" End If If String.IsNullOrEmpty(Destinatario) AndAlso Not String.IsNullOrEmpty(CC) Then Destinatario = CC CC = "" End If Asunto = Asunto.Replace(Environment.NewLine, " ") Dim myMessage As New MailMessage() ' Configuración del mensaje myMessage.Subject = Asunto myMessage.Body = Cuerpo myMessage.From = New MailAddress(Remitente, NombreRemitente) myMessage.IsBodyHtml = CuerpoenHTML ' Destinatarios For Each dest In Destinatario.Split(";"c).Where(Function(d) Not String.IsNullOrWhiteSpace(d)) myMessage.To.Add(New MailAddress(dest.Trim(), dest.Trim(), Encoding.UTF8)) Next ' CC If Not String.IsNullOrEmpty(CC) Then For Each c In CC.Split(";"c) myMessage.CC.Add(c.Trim()) Next End If ' BCC If Not String.IsNullOrEmpty(BCC) Then For Each b In BCC.Split(";"c) myMessage.Bcc.Add(b.Trim()) Next End If ' Responder a If String.IsNullOrWhiteSpace(ResponderA) Then myMessage.ReplyToList.Add(New MailAddress(Remitente, NombreRemitente)) Else myMessage.ReplyToList.Add(New MailAddress(ResponderA, ResponderA, Encoding.UTF8)) End If ' Adjuntos If AttachMents IsNot Nothing Then For Each att In AttachMents myMessage.Attachments.Add(att) Next End If ' Vistas alternativas If AlternateViews IsNot Nothing Then For Each av In AlternateViews myMessage.AlternateViews.Add(av) Next End If ' Configuración del cliente SMTP Dim SmtpMail As New SmtpClient(ServidorSMTP, Puerto) SmtpMail.EnableSsl = UsarSSL ' Obtener token OAuth Dim token = Await GetOAuthToken(ClientId, TenantId, ClientSecret, Remitente) ' Configurar credenciales OAuth SmtpMail.Credentials = New NetworkCredential(Remitente, token) SmtpMail.UseDefaultCredentials = False ' Configuración de seguridad ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 ServicePointManager.ServerCertificateValidationCallback = Function(s As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) True SmtpMail.Timeout = 1000 * 60 * 5 ' 5 minutos ' Envío del correo Await SmtpMail.SendMailAsync(myMessage) Catch ex As Exception Throw New Exception("Error al enviar correo: " & ex.Message, ex) End Try End Function Private Shared ListadoTokens As New List(Of TokenMicrosoft) Private Shared Async Function GetOAuthToken(ByVal ClientId As String, ByVal TenantId As String, ByVal ClientSecret As String, ByVal Remitente As String) As Task(Of String) Dim tm = ListadoTokens.FirstOrDefault(Function(x) x.id = ClientId & "-" & TenantId) If tm Is Nothing Then tm = New TokenMicrosoft tm.id = ClientId & "-" & TenantId ListadoTokens.Add(tm) End If If tm.FechaCreacion.HasValue = False OrElse Date.UtcNow.Subtract(tm.FechaCreacion).TotalMinutes > 30 Then tm.FechaCreacion = Date.UtcNow Dim app As IConfidentialClientApplication Dim result As AuthenticationResult = Nothing Dim scopes As String() = {"https://outlook.office365.com/.default"} ' Primero intentamos con credenciales de cliente (si hay ClientSecret) If Not String.IsNullOrEmpty(ClientSecret) Then app = ConfidentialClientApplicationBuilder.Create(ClientId) _ .WithAuthority(AzureCloudInstance.AzurePublic, TenantId) _ .WithClientSecret(ClientSecret) _ .Build() Try result = Await app.AcquireTokenForClient(scopes).ExecuteAsync() Return result.AccessToken Catch ex As MsalServiceException Throw New Exception("Error al obtener token con credenciales de cliente: " & ex.Message, ex) End Try End If ' Si no hay ClientSecret o falló, intentamos con flujo interactivo (solo para desarrollo) Dim publicApp = PublicClientApplicationBuilder.Create(ClientId) _ .WithAuthority(AzureCloudInstance.AzurePublic, TenantId) _ .Build() Try result = Await publicApp.AcquireTokenInteractive(scopes).ExecuteAsync() tm.Token = result.AccessToken Return result.AccessToken Catch ex As MsalServiceException Throw New Exception("Error al obtener token interactivo: " & ex.Message, ex) End Try Else Return tm.Token End If End Function Private Class TokenMicrosoft Property id As String Property FechaCreacion As DateTime? Property Token As String End Class End Class