Внимание: акция!
Только 31 декабря и 1 января — скидка на все надстройки 50% при оплате через СБП
(оплачиваете половину от стоимости, указанной на странице приобретения лицензии)
Проверка доступности прокси сервера макросом VBA |
Этот код проверяет заданного доступность прокси сервера при помощи функции CheckProxyServer:
Sub ПримерПроверкиПроксиСервера() myProxy$ = "212.45.5.172:3128" If CheckProxyServer(myProxy$) Then MsgBox "Прокси сервер с адресом " & myProxy$ & " доступен!", vbInformation Else MsgBox "Прокси сервер с адресом " & myProxy$ & " недоступен!", vbExclamation End If End Sub
Прокси-сервер (Proxy Server) позволяет скрыть ваш IP адрес, что позволяет вам выполнять запросы к одному и тому же серверу как-бы с разных компьютеров.
Это может быть полезно при выполнении многократных запросов к серверам типа Яндекс и Google,
которые блокируют автоматические запросы от программы по истечении некоторого времени.
Загрузить список прокси-серверов вам поможет этот код: http://excelvba.ru/code/ProxyServersList
Код функции CheckProxyServer:
Function CheckProxyServer(ByVal Proxy$) As Boolean ' функция проверяет работоспособность прокси сервера Proxy$, ' выполняя запрос IP на сайте internet.yandex.ru ' Если Яндекс возвращает IP адрес прокси-сервера в течение ' непродолжительного времени, считаем данный прокси-сервер рабочим ' Функция возвращает TRUE, если прокси сервер рабочий On Error Resume Next: Err.Clear With CreateObject("MSXML2.ServerXMLHTTP.6.0") .setProxy 2, Proxy$ .Open "GET", "http://internet.yandex.ru/", False .setTimeouts 10000, 10000, 10000, 10000 .send ("") txt = Split(Split(.responseText, "Мой IP: ")(1), "<")(0) End With CheckProxyServer = (Proxy$ Like txt & ":*") And (Err = 0) End Function
- 12911 просмотров
Комментарии
Ой забыл вернуть CreateObject("MSXML2.ServerXMLHTTP.6.0")
Сейчас как-то так:
Sub CheckProxyServer()
Dim proxy As String
'You'll need to Add a reference to Microsoft HTML Object Libarary
Dim html As MSHTML.HTMLDocument
proxy = "185.8.4.105:8080"
On Error Resume Next: Err.Clear
With CreateObject("MSXML2.XMLHttp")
.setProxy 2, proxy
.Open "GET", "http://yandex.ru/internet/", False
.setTimeouts 10000
.send ("")
If .Status = 200 Then
Set html = CreateObject("htmlfile")
html.body.innerHTML = .responseText
Set ipv4 = html.getElementsByClassName("client__item_type_ipv4")
MsgBox (ipv4(0).innerText)
End If
End With
End Sub
Как по мне удобнее в HTML или XML потрошить ответы сервера.
Спасибо! А как изменить код функции, чтобы это работало в современных реалиях? Сейчас эта страницы доступна по адресу https://yandex.ru/internet/, и вместо "Мой IP: ", видимо нужно что-то другое прописать. Только не соображу что именно.
Спасибо большое!
Нужно заменить "<" на vbLf
добавить DoEvents, чтоб остановить можно было.
Отправить комментарий