-Поиск по дневнику

Поиск сообщений в rss_sql_ru_access_programming

 -Подписка по e-mail

 

 -Постоянные читатели

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 16.03.2006
Записей:
Комментариев:
Написано: 4


Как пройти аутентификацию при подключении к веб-узлу?

Понедельник, 29 Декабря 2014 г. 14:13 + в цитатник
Есть процедурка, написанная в VBA под аксессом:

    strURL = "https://sub.site.ru/download/All"

    'Создаём элемент эксплорера
    Set IE = CreateObject("InternetExplorer.Application")
    'Переходим по адресу
    IE.navigate strURL
    Do While IE.Busy Or IE.ReadyState <> 4 'READYSTATE_COMPLETE
        DoEvents
    Loop

+ листинг целиком
Private Sub btnRIC_Click()
    Dim strURL As String
    
    Dim IE As Object
    Dim hDoc As MSHTML.HTMLDocument
    Dim hCol As MSHTML.IHTMLElementCollection
    Dim hCell As MSHTML.IHTMLTableCell
    Dim hRow As MSHTML.IHTMLTableRow
    
    Dim HTTP As MSXML2.XMLHTTP
    
    Dim RS As ADODB.Recordset
    
    Dim i As Integer
    Dim sFileName
    Dim dFileDate As Date
    Dim sUrl As String
    
    Dim iFreeFile As Integer
    Dim vFileName As Variant
    Dim bFileDate() As Byte
    Dim sFolderName As String

On Error GoTo ErrHandler


    strURL = "https://sub.site.ru/download/All"
    sFolderName = "C:\11"

    'Создаём элемент эксплорера
    Set IE = CreateObject("InternetExplorer.Application")
    'Переходим по адресу
    IE.navigate strURL
    Do While IE.Busy Or IE.ReadyState <> 4 'READYSTATE_COMPLETE
        DoEvents
    Loop

    'Грузим документ
    Set hDoc = New MSHTML.HTMLDocument
    Set hDoc = IE.Document
    Do While Not hDoc.ReadyState = "complete"
        DoEvents
    Loop
    
'    Dim SSS As String
'    SSS = hDoc.body.innerHTML
'    udfClipBoardSetData (SSS)

    'Грузим коллекцию однотипных элементов (getElementsBy...)
    Set hCol = hDoc.getElementsByClassName("NewPackage")
    For i = 0 To hCol.Length - 1
        Set hRow = hCol.Item(i)
        dFileDate = hRow.cells(0).innerText
        sFileName = hRow.cells(2).innerText
        sUrl = hRow.cells(2).all.Item(1)
        
        Set HTTP = New MSXML2.XMLHTTP
        HTTP.Open "GET", sUrl, False
        HTTP.send
        
        sFileName = sFolderName & "\" & sFileName
        'Проверяем, не существует ли уже этот файл?
        If Len(Dir(sFileName)) > 0 Then
            Kill sFileName
            If Len(Dir(sFileName)) > 0 Then
                MsgBox "Не удалось сохранить файл!", vbExclamation, "Ошибка открытия"
                GoTo ExitHere
            End If
        End If
        'Записываем данные
        iFreeFile = FreeFile
        Open sFileName For Binary Access Write As iFreeFile
        'Переписываем данные в массив - ибо из рекордсета он тянуть на прямую желает, но желает это коряво
        ReDim bFileDate(0 To LenB(HTTP.responseBody) - 1)
        bFileDate = HTTP.responseBody
        'Заливаем в файл
        Put iFreeFile, , bFileDate
        Close iFreeFile
        
    Next i

ExitHere:
    Set IE = Nothing
    Set hDoc = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Source & "-->" & Err.Number & ":" & Err.Description, vbExclamation, "Error"
    Resume ExitHere
    Resume
End Sub

На строке IE.navigate strURL сайт запрашивает авторизацию, которая выглядит так, как изображено на картинке.
Я что смог найти - прочитал, но всё равно не понял, как мне авторизироваться средствами VBA. Видимо, это тип аутентификации чисто виндусового сервера, через какие-то средства Windows...

Подскажите, как пройти аутентификацию в подобном случае?

Может, надо спросить в другом разделе, но я, если честно, хз куда обратиться, то ли в Visual Basic, то ли в HTML, JavaScript, VBScript, CSS то ли вообще в семейство Microsoft.NET... А аксессный форум такой родной :)

http://www.sql.ru/forum/1135098/kak-proyti-autentifikaciu-pri-podkluchenii-k-veb-uzlu


 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку