Загрузка данных


Imports System
Imports System.Collections.Generic
Imports System.Net
Imports System.Security.Cryptography.X509Certificates
Imports System.Text
Imports System.Text.Json
Imports Microsoft.Identity.Client

Namespace TeamsCertAuth

    Module Program

        ' Настройки регистрации приложения в Azure AD
        Private Const TenantId As String = "YOUR_TENANT_ID"
        Private Const ClientId As String = "YOUR_CLIENT_ID"
        Private Const CertThumbprint As String = "YOUR_CERT_THUMBPRINT"
        Private Const CertStoreNameValue As StoreName = StoreName.My
        Private Const CertStoreLocationValue As StoreLocation = StoreLocation.CurrentUser

        Private Const GraphBaseUrl As String = "https://graph.microsoft.com/v1.0"

        Sub Main(args As String())
            Dim recipientUserId As String = "USER_OBJECT_ID_OR_UPN"
            Dim messageText As String = "Привет! Это тестовое сообщение из VB.NET."

            Dim certificate As X509Certificate2 = GetCertificateByThumbprint(CertThumbprint, CertStoreNameValue, CertStoreLocationValue)
            Dim accessToken As String = GetAccessToken(certificate)

            Dim chatId As String = GetOrCreateOneOnOneChat(accessToken, recipientUserId)
            SendMessage(accessToken, chatId, messageText)

            Console.WriteLine("Сообщение отправлено.")
        End Sub

        Private Function GetCertificateByThumbprint(
            thumbprint As String, storeName As StoreName, storeLocation As StoreLocation) As X509Certificate2

            Using store As New X509Store(storeName, storeLocation)
                store.Open(OpenFlags.ReadOnly)

                Dim certs = store.Certificates.Find(X509FindType.FindByThumbprint, thumbprint, validOnly:=False)
                If certs.Count = 0 Then
                    Throw New InvalidOperationException(
                        $"Сертификат с отпечатком {thumbprint} не найден в хранилище {storeLocation}/{storeName}.")
                End If

                Return certs(0)
            End Using
        End Function

        Private Function GetAccessToken(certificate As X509Certificate2) As String
            Dim app As IConfidentialClientApplication = ConfidentialClientApplicationBuilder.
                Create(ClientId).
                WithCertificate(certificate).
                WithAuthority(AzureCloudInstance.AzurePublic, TenantId).
                Build()

            Dim scopes As String() = {"https://graph.microsoft.com/.default"}

            ' Блокирующий вызов вместо Await
            Dim result As AuthenticationResult = app.AcquireTokenForClient(scopes).
                ExecuteAsync().
                GetAwaiter().
                GetResult()

            Return result.AccessToken
        End Function

        Private Function CreateGraphClient(accessToken As String) As WebClient
            Dim client As New WebClient()
            client.Headers(HttpRequestHeader.Authorization) = "Bearer " & accessToken
            client.Headers(HttpRequestHeader.ContentType) = "application/json"
            client.Encoding = Encoding.UTF8
            Return client
        End Function

        Private Function GetOrCreateOneOnOneChat(accessToken As String, recipientUserId As String) As String
            Dim json As String = BuildChatRequestJson(recipientUserId)

            Using client As WebClient = CreateGraphClient(accessToken)
                Dim response As String = client.UploadString($"{GraphBaseUrl}/chats", "POST", json)

                Using doc As JsonDocument = JsonDocument.Parse(response)
                    Return doc.RootElement.GetProperty("id").GetString()
                End Using
            End Using
        End Function

        Private Function BuildChatRequestJson(recipientUserId As String) As String
            ' "@odata.type" и "user@odata.bind" содержат символы, недопустимые в именах свойств VB.NET,
            ' поэтому JSON собирается вручную через Dictionary(Of String, Object).
            Dim member As New Dictionary(Of String, Object) From {
                {"@odata.type", "#microsoft.graph.aadUserConversationMember"},
                {"roles", New String() {"owner"}},
                {"user@odata.bind", $"https://graph.microsoft.com/v1.0/users('{recipientUserId}')"}
            }

            Dim payload As New Dictionary(Of String, Object) From {
                {"chatType", "oneOnOne"},
                {"members", New Object() {member}}
            }

            Return JsonSerializer.Serialize(payload)
        End Function

        Private Sub SendMessage(accessToken As String, chatId As String, text As String)
            Dim body As New Dictionary(Of String, Object) From {
                {"contentType", "text"},
                {"content", text}
            }

            Dim payload As New Dictionary(Of String, Object) From {
                {"body", body}
            }

            Dim json As String = JsonSerializer.Serialize(payload)

            Using client As WebClient = CreateGraphClient(accessToken)
                client.UploadString($"{GraphBaseUrl}/chats/{chatId}/messages", "POST", json)
            End Using
        End Sub

    End Module