Получить от сайта с авторизацией данные

@ooos · Регистрация: 08.04.2021

Студворк — интернет-сервис помощи студентам

Здравствуйте.
Почему в Immediate Window (строка 56) Debug.Print HTMLcode я получаю dataType: "json"

Кликните здесь для просмотра всего текста

dataType: "json",
lsId: "sync-mailbox",
lsTimeout: ExternalMail.interval / 100 * 80,
lsForce: force ? true : false,
onsuccess: function (json)
{
if (!BX.Type.isPlainObject(json))
{
..............................
............................
...........................
<script>BX.onCustomEvent(window, "onScriptsLoaded");</script>
</body></html>

хотя в окне Locals явно видно, что значение HTMLcode именно то, что нужно?

Соответственно - переход на 63. GetV_Err: . Как это исправить?

Visual Basic
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
68
69
70
71
72
73
74
75
76
77
78
Sub AuthenticationEndTimeParsing()
   
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
   
    Dim username As String
    Dim password As String
    Dim authHeader As String
    
    username = "******"
    password = "******"
    
    Dim credentials As String
    credentials = username & ":" & password
    
    Dim base64Credentials As String
    base64Credentials = Base64Encode(credentials)
    
    http.Open "GET", "https://bitrix24.контора.домен", False
    http.setRequestHeader "Authorization", "Basic " & base64Credentials
    http.send
    ' Проверяем статус ответа
        If http.Status = 200 Then
            Dim pShell As Object
            Set pShell = CreateObject("WScript.Shell")
            CreateObject("WScript.Shell").Popup "Статус ответа - ОК.", 2, "Вы авторизованы", 64
            Set pShell = Nothing 
           
            Dim ff
            ff = FreeFile
            Open "C:\Users\Ooos\Desktop\Ответ.txt" For Output As #ff
            Print #ff, "Ответ: " & http.responseText
           
            Dim MyFSO As New FileSystemObject ' - Интересуемся полным ответом из 3500 строк.
'           Call Shell("C:\Windows\System32\Notepad.exe" & " " & "C:\Users\Ooos\Desktop\Ответ.txt", vbNormalFocus)
    
        Else
            MsgBox "Error: " & http.Status & " - " & http.statusText
        End If
    Set httpRequest = Nothing 
 
    '--------------------------------------------------------------------------
    Dim sDate$, pLeft As Integer, pRight As Integer, v As Variant
       
    On Error GoTo GetV_Err
    
    sURI = "https://bitrix24.контора.домен/timeman/timeman.php/"
    Debug.Print sURI
    
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    
    oHttp.Open "GET", sURI, False  ' Отправляем GET-запрос к API
    oHttp.send
    HTMLcode = oHttp.responseText
    Debug.Print HTMLcode
    
    pLeft = InStr(1, HTMLcode, "data-id=""998""")
    pRight = InStr(pLeft, HTMLcode, "<div class=""main-ui-pagination-pages"">")
    v = Val(Mid(HTMLcode, pLeft, pRight - pLeft)) 
    Debug.Print "Завершено: " & v
       
GetV_Err:
    On Error Resume Next
    Set oHttp = Nothing
    Exit Sub
End Sub
 
Function Base64Encode(inData As String) As String
    Dim arrData() As Byte
    arrData = StrConv(inData, vbFromUnicode)
    Dim objXML As Object
    Dim objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    Base64Encode = objNode.Text
End Function

@testuser2 · 17.02.2025, 05:12

Не может быть

@ooos · 18.02.2025, 14:11 **[ТС]**

Сообщение от testuser2

Не может быть

testuser2, если Вас не затруднит - прокомментируйте пожалуйста, чуть более развёрнуто, что именно не может быть и почему?

@The_Prist · 18.02.2025, 14:25

Не может быть, что в Locals и в Immediate разная информация для одной переменной.
Есть подозрение, что неправильно просматриваете. В Immediate допустимо вывести не более 255 символов переменной. У Вас там явно больше и выводятся последние 255 символов переменной.
Попробуйте выводить так:

Visual Basic
1
Debug.Print Left(HTMLcode,255)

и сравните что там и что в Locals.

@ooos · 18.02.2025, 15:06 **[ТС]**

Сообщение от The_Prist

Не может быть, что в Locals и в Immediate разная информация для одной переменной.

Дмитрий Валентинович, Вы как всегда правы, сделал:

Visual Basic
1
2
3
4
5
6
7
Debug.Print Left(HTMLcode, 255)
    Dim fff
            fff = FreeFile
            Open "C:\Users\Ooos\Desktop\HTMLcode.txt" For Output As #fff
            Print #fff, "HTMLcode: " & HTMLcode
           
            Dim MyFSO2 As New FileSystemObject ' - Смотрим полный HTMLcode из 3553 строк.

и в Immediate получил:

Visual Basic
1
2
3
4
<!DOCTYPE html><html ><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0, shrink-to-fit=no" />
<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<script data

затем в HTMLcode.txt увидел полную страницу с нужными тэгами и в её конце уже

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
[JS]var ExternalMail = {
            interval: 600       };
 
        ExternalMail.check = function (force)
        {
            BX.ajax({
                url: "/bitrix/tools/check_mail.php?SITE_ID=s1",
                dataType: "json",
                lsId: "sync-mailbox",
                lsTimeout: ExternalMail.interval / 100 * 80,
                lsForce: force ? true : false,
                onsuccess: function (json)..........[/JS]

Осталось правильно извлечь нужные данные.
Спасибо Вам!

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@testuser2 1390 / 847 / 92 Регистрация: 08.02.2017 Сообщений: 3,613 Записей в блоге: 2
	17.02.2025, 05:12
	Не может быть 1

Получить от сайта с авторизацией данные

Решение