powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / HTTPRequest
11 сообщений из 11, страница 1 из 1
HTTPRequest
    #39742209
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Здравствуйте.
Функция возвращает HTML-текст страницы. Обработал кучу страниц, пока не наткнулся на одну, которая вместо текста на кириллице возвращает вот такую фигню:
Подскажете, как с этим бороться?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Public Function fncText_HTTP(strURL As String) As String                              'возвращает HTML-текст страницы
Dim oHttp1 As Object
On Error GoTo Ошибка
Set oHttp1 = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
    Set oHttp1 = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp1 Is Nothing Then
    MsgBox "Не удалось инициализировать объект MSXML!"
    Exit Function
End If
On Error GoTo Ошибка
oHttp1.Open "GET", strURL, True                                                       'true - асинхронный запуск
oHttp1.Send
    Do While oHttp1.ReadyState <> 4                                                   'ожидание ответа
        DoEvents
    Loop
fncTextHTTP = oHttp1.ResponseТекст
    Set oHttp1 = Nothing
Exit Function
Ошибка:                                                                               'Обработка ошибки
MsgBox Err.Description & "  " & Err.Number, , "Function fncText_HTTP"
Resume Next
End Function
...
Рейтинг: 0 / 0
HTTPRequest
    #39742214
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Извиняюсь, в конце скрипта: fncTextHTTP = oHttp1.ResponseText
...
Рейтинг: 0 / 0
HTTPRequest
    #39742230
PWW
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
l-evgene,

А вот так?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
    sURL = "https://yandex.ru/" 'указать протокол!
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        .send
        GetHTTPResponse = .responseText 'тут страница
    End With
    Set oXMLHTTP = Nothing
...
Рейтинг: 0 / 0
HTTPRequest
    #39742231
PWW
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
l-evgene,

Ваш код выдает ошибку при попытке запросить страницу, хотя внешне выглядит правильно.
...
Рейтинг: 0 / 0
HTTPRequest
    #39742235
Eugene-LS
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
l-evgene, а ссылку на страницу не подскажете?
...
Рейтинг: 0 / 0
HTTPRequest
    #39742241
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
HTTPRequest
    #39742244
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
PWWl-evgene,

А вот так?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
    sURL = "https://yandex.ru/" 'указать протокол!
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        .send
        GetHTTPResponse = .responseText 'тут страница
    End With
    Set oXMLHTTP = Nothing



А чем этот скрипт отличается от исходного?
...
Рейтинг: 0 / 0
HTTPRequest
    #39742273
Фотография Панург
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
l-evgene, поправь так для начала...

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
...
    Do While oHttp1.ReadyState <> 4                                                   'ожидание ответа
        DoEvents
    Loop
'fncTextHTTP = oHttp1.ResponseТекст
Dim strm As Object 'ADODB.Stream

Set strm = CreateObject("ADODB.Stream")
strm.Open
strm.Type = 1
strm.Write oHttp1.responseBody
strm.Position = 0
strm.Type = 2
strm.Charset = "windows-1251"
fncText_HTTP = strm.ReadText
strm.Close
Set strm = Nothing
'fncText_HTTP = oHttp1.responseText
    Set oHttp1 = Nothing
Exit Function
Ошибка:  
...  
...
Рейтинг: 0 / 0
HTTPRequest
    #39742281
Eugene-LS
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
l-evgene - у меня получилось так:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
Public Sub test01()
Dim sPath$, s$
    s = GetHTMLPageByURL2("http://www.sport-imp.ru/?categoryID=2/")
    'DoEvents
'Назначаенм куда ...
    sPath = "d:\Temp\TempTest01.html"
'Запись
    If Len(s) > 2 Then TextOutputAsTXT sPath, s
End Sub

Public Function GetHTMLPageByURL2(URL$) As String
Const READYSTATE_COMPLETE = 4
Dim IE As Object
Dim html As Object
Dim htmlBody As Variant


Set IE = CreateObject("InternetExplorer.Application")
    'IE.Top = 0
    'IE.Left = 0
    'IE.Width = 800
    'IE.Height = 600
    
    'IE.Visible = True
    'IE.Visible = False
    IE.navigate URL$


'Wait until IE is done loading page
    Do While IE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop

'HTML document returned
    Set html = IE.Document
    GetHTMLPageByURL2 = html.DocumentElement.innerHTML

    IE.Visible = True
    IE.Quit
    Set IE = Nothing

End Function


Public Sub TextOutputAsTXT(sTXTPath$, sText$)
'Запись в текстовый файл по пути sTXTPath - текста переданного в sText
'Внимание: Если Файл уже существует - переписывается полностью и без вопросов.
Dim fso As Object
Dim ts As Object
'--------------------------------------------------------------------------
On Error GoTo TextOutputAsTXT_Err
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'Третий параметр <Unicode>. Если он True, файл в юникоде, если False , то в ASCII. По умолчанию стоит False.
    Set ts = fso.CreateTextFile(sTXTPath, True, False)
    ts.Write sText
    ts.Close
TextOutputAsTXT_Bye:
    On Error Resume Next
    Set ts = Nothing: Set fso = Nothing
    Exit Sub

TextOutputAsTXT_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: TextOutputAsTXT", vbCritical, "Error!"
    Resume TextOutputAsTXT_Bye
End Sub
...
Рейтинг: 0 / 0
HTTPRequest
    #39742284
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Панург,

йесссс!!!
Получилось. Большое спасибо!
...
Рейтинг: 0 / 0
HTTPRequest
    #39742317
l-evgene
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Eugene-LS, спасибо! Тоже получилось.

Странное дело. Текст body (между <body... и </body>), полученный через IE, на 10% длиннее полученного через XMLHTTPRequest.
22500 и 20300 знаков соответственно.
Попробую разобраться.
...
Рейтинг: 0 / 0
11 сообщений из 11, страница 1 из 1
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / HTTPRequest
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]