tsl5/CorreoOAuth2.vb

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