Ошибка COM-объекта MSXML2.XMLHTTP при работе по протоколу TLS 1.3

[McConst]

Добрый день.
Есть ресурс kdb-gw.prod.kitco.com к которому я хочу сделать POST запрос  для получения биржевой цены на родий.
Код для скачивания такой

Код (vb) Выделить Развернуть


Public Function get_Rh_fromKITCO() As String
'Подгрузка с kitco.com данных о ценах на Rh

Dim http As Object 'Объект для выполнения запроса через XMLHttpRequest
Dim body As String '
Dim URL As String 'Адрес сервера, к которому осуществляется запрос
Dim textResponse As String 'Ответ сервера в текстовом виде
Dim RegExp As Object 'Объект для работы с регулярными выражениями при парсинге страницы
Dim resultRegExp As Object 'Результат работы регулярного выражения
Dim bid As Double, ask As Double


URL = "https://kdb-gw.prod.kitco.com"
Set http = CreateObject("MSXML2.XMLHTTP")

body = "{""query"":""fragment MetalFragment on Metal { ID symbol currency name results { ...MetalQuoteFragment } } " & _
     "fragment MetalQuoteFragment on Quote { ID ask bid change changePercentage close high low mid open originalTime timestamp unit } " & _
     "query MetalQuote( $symbol: String! $currency: String! $timestamp: Int ) " & _
     "{ GetMetalQuoteV3( symbol: $symbol currency: $currency timestamp: $timestamp ) " & _
     "{ ...MetalFragment } }"",""variables"":{""symbol"":""RH"",""currency"":""USD"",""timestamp"":1718003520},""operationName"":""MetalQuote""}"


http.Open "POST", URL, False 'False - синхронное соединение

On Error GoTo ext:
http.Send (body)

textResponse = http.responseText

Set RegExp = CreateObject("VBScript.RegExp") 'Создаём объект для работы с регулярными выражениями
RegExp.Global = False 'Ищем первое совпадение

RegExp.Pattern = """bid\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
bid = resultRegExp(0).SubMatches(0)

RegExp.Pattern = """ask\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
ask = resultRegExp(0).SubMatches(0)


get_Rh_fromKITCO = WorksheetFunction.Min(bid, ask)



Exit Function
ext:
    'Выход из функции по ошибки
    get_Rh_fromKITCO = Err.Description
End Function



Код возвращает ошибку: "Ошибка скачивания указанного ресурса".

Изучение информации о ресурсе показало, что сервис работает по протоколу TLS 1.3
Ошибка работы протоколов при запросах достаточно распространённая. Объект MSXML2.XMLHTTP настраивается в "Свойствах обозревателя" Internet Explorer включением соответствующих галок сертификатов безопасности.
К сожалению у меня операционка windows 7 и TLS 1.3 невозможно включить, так как он отсутствует в опциях.

И да, IE 11  не хочет открывать https://kdb-gw.prod.kitco.com/ из браузерной строки, хотя Chrome и даже Microsoft Edge нормально открывают этот ресурс.
Замена MSXML2.XMLHTTP на WinHttp.WinHttpRequest.5.1 ничего не даёт. Та же ошибка, сформулированная по другому: "Ошибка поддержки безопасных каналов"

1. Существуют ли способы для парсинга страниц на VBA подключать не библиотеки Internet Explorer, а хотя бы COM-объекты Microsoft Edge (если есть такие)?
Вариант с Selenium возможен, но трудоёмок при портировании книги Excel на другие машины. Нужно искать и инсталлить совместимые версии библиотек.

2. Может можно поставить какие-то патчи или сертификаты на Win7, чтобы TLS 1.3 заработал? Другие же браузеры работают нормально с этим ресурсом.

В последнее время проблем с TLS 1.3 встречается всё чаще. Например, Telegram API работает по этому протоколу и из VBA невозможно без танцев с бубном отправить в телеграм-бот сообщение.

Я для себя нашел кривое решение. На своём удалённом хосте написал php-скрипт

Код (php) Выделить Развернуть


<?php
//Серверный модуль для обхода ограничений кросс-доменных запросов


$html = "incorrect request";

header('Access-Control-Allow-Origin: *');
header('Access-Control-Allow-Credentials: true');
header('Access-Control-Allow-Headers: X-Requested-With');
header('Content-type: text/html; charset=utf-8');


//Получен запрос на чтение HTML по адресу url
$url = 'https://kdb-gw.prod.kitco.com';

$body='{"query":"fragment MetalFragment on Metal { ID symbol currency name results { ...MetalQuoteFragment } } fragment MetalQuoteFragment on Quote { ID ask bid change changePercentage close high low mid open originalTime timestamp unit } query MetalQuote( $symbol: String! $currency: String! $timestamp: Int ) { GetMetalQuoteV3( symbol: $symbol currency: $currency timestamp: $timestamp ) { ...MetalFragment } }","variables":{"symbol":"RH","currency":"USD","timestamp":'.time().'},"operationName":"MetalQuote"}';

$ch = curl_init($url);
curl_setopt($ch, CURLOPT_HTTPHEADER, array('Content-Type:application/json'));
curl_setopt($ch, CURLOPT_POST, 1);
curl_setopt($ch, CURLOPT_POSTFIELDS, $body); 
curl_setopt($ch, CURLOPT_RETURNTRANSFER, true);
curl_setopt($ch, CURLOPT_SSL_VERIFYPEER, false);
curl_setopt($ch, CURLOPT_HEADER, false);
$res = curl_exec($ch);
curl_close($ch);
 
$res = json_encode($res, JSON_UNESCAPED_UNICODE);
print_r($res);


и делаю запрос из VBA к https://glpa.catalyst.by/stat/php/vpn-kitco-rh.php , который данные возвращает в читаемом для Internet Explorer виде.

Код (vb) Выделить Развернуть


Public Function get_Rh_fromKITCO2() As String
'Подгрузка с kitco.com данных о ценах на Rh
'Возврат через глобальную коллекцию currencies
Dim http As Object 'Объект для выполнения запроса через XMLHttpRequest

Dim URL As String 'Адрес сервера, к которому осуществляется запрос
Dim textResponse As String 'Ответ сервера в текстовом виде
Dim RegExp As Object 'Объект для работы с регулярными выражениями при парсинге страницы
Dim resultRegExp As Object 'Результат работы регулярного выражения
Dim bid As Double, ask As Double


URL = "https://glpa.catalyst.by/stat/php/vpn-kitco-rh.php"
Set http = CreateObject("MSXML2.XMLHTTP")

http.Open "GET", URL, False 'False - синхронное соединение
http.setRequestHeader "Content-Type", "application/json; charset=utf-8"

On Error GoTo ext:
http.Send

textResponse = http.responseText

Set RegExp = CreateObject("VBScript.RegExp") 'Создаём объект для работы с регулярными выражениями
RegExp.Global = False 'Ищем первое совпадение

RegExp.Pattern = """bid\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
bid = resultRegExp(0).SubMatches(0)

RegExp.Pattern = """ask\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
ask = resultRegExp(0).SubMatches(0)


get_Rh_fromKITCO = WorksheetFunction.Min(bid, ask)



Exit Function
ext:
    'Выход из функции по ошибке
    get_Rh_fromKITCO = err.Description
End Function


Есть ли более оптимальные решения описанной проблемы?