Загрузка данных
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