Доступ к веб-сервису с учетными данными с использованием vba

Question

Я работаю над более длинным сценарием для Access, и в какой-то момент необходимо проверить веб-сервис на наличие последней версии файла (имя файла). Этот веб-сервис доступен только через браузер с URL-адресом, подобным https://webservice.example.com:1234/Server/test.jsp?parameter=value, после чего необходимо пройти аутентификацию с помощью всплывающего пароля стандартного имени пользователя браузера. Конечно, я мог бы пропустить это всплывающее окно, если бы вместо этого использовал что-то вроде https://user:password@webservice.example.com:1234/Server/test.jsp?parameter=value. (Обратите внимание, что на данном этапе речь идет не о безопасности, пароль существует только для того, чтобы иметь пароль, и его вполне допустимо хранить в виде открытого текста)

В данный момент я уже использую следующий рабочий код для получения информации от другого Веб-сайт:

Dim appIE As Object
Dim sURL as String, infoStr as String
Set appIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'class id of InternetExplorerMedium
sURL = "https://webservice.example.com:1234/Server/test.jsp?parameter=value"
With appIE
    .Navigate sURL
    .Visible = False
End With

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop

infoStr = appIE.Document.getElementsByTagName("body").item.innerText

Однако, если я добавлю учетные данные в URL, как я сделал бы в браузере sURL = "https://user:password@webservice.example.com:1234/Server/test.jsp?parameter=value" Я получу следующую ошибку:

Ошибка времени выполнения «-2146697202 (800c000e)»: метод «навигация» объекта «IWebBrowser2» не удалось

Кто-нибудь знает, почему происходит сбой, если я добавляю учетные данные, или у кого-нибудь есть идеи, как это сделать по-другому?

Answer 1

Если для вашего веб-сайта требуется обычная проверка подлинности, аутентификацию с использованием основного заголовка проверки подлинности сравнительно легко.

Нам нужно иметь возможность кодировать содержимое Base64, поэтому сначала нам нужно определить вспомогательную функцию для этого:

Public Function ToBase64(Bytes() As Byte) As String
    Dim XMLElement As Object
    Set XMLElement = CreateObject("Msxml2.DOMDocument.6.0").createElement("tmp")
    XMLElement.DataType = "bin.base64"
    XMLElement.nodeTypedValue = Bytes
    ToBase64 = Replace(XMLElement.Text, vbLf, "")
End Function

Затем второй помощник для создания основного заголовка аутентификации:

Public Function CreateBasicAuthHeader(Username As String, Password As String) As String
    'Assuming ASCII encoding, UTF-8 is harder
    CreateBasicAuthHeader = "Authorization: Basic " & ToBase64(StrConv(Username & ":" & Password, vbFromUnicode))
End Function

Быстрая проверка показывает, что ?CreateBasicAuthHeader("Aladdin", "OpenSesame") возвращает Authorization: Basic QWxhZGRpbjpPcGVuU2VzYW1l, что является ожидаемым заголовком согласно Wikipedia

Затем вы можете использовать это в методе Navigate:

Dim appIE As Object
Dim sURL as String, infoStr as String
Set appIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'class id of InternetExplorerMedium
sURL = "https://webservice.example.com:1234/Server/test.jsp?parameter=value"
With appIE
    .Navigate sURL, Headers:=CreateBasicAuthHeader("MyUsername", "MyPassword")
    .Visible = False
End With

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop

infoStr = appIE.Document.getElementsByTagName("body").item.innerText

Предполагается, что сервер либо ожидает кодировку ASCII, либо ваше имя пользователя и пароль являются только символами ASCII, а сервер ожидает кодировку UTF-8.