Проверить активное интернет-соединение

Question

Написал небольшое приложение, которое обращается к множеству поисковых сайтов и помещает результаты в текстовый документ, который запускается несколько сотен раз в день.

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

Это отлично работает, хотя и не быстро. Люди впечатлены тем, что еще несколько недель назад они делали это вручную, буквально загружая шесть различных поисковых сайтов, осуществляя поиск, а затем копируя и вставляя результаты в текстовый документ.

Однако Интернет нашего офиса ненадежен и последние полдня не работает. Это означает, что около 400 неудачных поисков были сохранены в локальных папках и вставлены в окончательные документы.

Когда человек искал, он мог сказать, был ли интернет сломан, и они будут делать свои поиски позже. Очевидно, однако, что это приложение не может сказать, и потому что я не использую API или что-то еще, и поскольку я ограничен использованием среды VBA (мне даже не разрешают инструменты MZ), мне нужно найти какой-то способ убедитесь, что интернет работает, прежде чем продолжить выполнение программы, не полагаясь на слишком много ссылок и, желательно, без скрининга фразы «404 Page Not Found».

Я не очень знаком с VB, и VBA разрушает меня во многих отношениях, так что, вероятно, есть какой-то простой способ сделать это, поэтому я спрашиваю здесь.

Ценю любую помощь.

Answer 1

Очевидно, что ваша проблема имеет много уровней. Вам следует начать с определения «подключен к Интернету» и приступить к разработке резервных стратегий, которые включают отказ от записи недопустимых файлов при сбое.

Что касается вопроса «подключен ли я», вы можете попробовать подключиться к Win32 API:

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long ) As Long

Public Function GetInternetConnectedState() As Boolean
  GetInternetConnectedState = InternetGetConnectedState(0&,0&)
End Function

Хотя в зависимости от настроек вашей сети (ограничения прокси / NAT / брандмауэра и т. Д.), У Windows может быть другое мнение по этому поводу.

Попытка получить интересующие вас страницы, проверка статуса возврата в заголовках HTTP (тайм-аут шлюза, 404, что бы вы ни ожидали, когда он «не работает») также может быть подходом. 1008 *

Answer 2

Вы можете использовать библиотеку MSXML и использовать класс XMLHttpRequest для проверки вещей

, например

On Error Resume Next
Dim request As MSXML2.XMLHTTP60
request.Open "http://www.google.com"
request.Send
Msgbox request.Status

Статус даст вам HTTP-код состояния того, что произошло с запросом. Возможно, вам придется сделать еще несколько проверок, в зависимости от вашего сценария.

Надеюсь, это поможет.

Answer 3

Используйте следующий код для проверки интернет-соединения первый доступный XML v6.0 в ваших ссылках

Function checkInternetConnection() As Integer
'code to check for internet connection
'by Daniel Isoje
On Error Resume Next
 checkInternetConnection = False
 Dim objSvrHTTP As ServerXMLHTTP
 Dim varProjectID, varCatID, strT As String
 Set objSvrHTTP = New ServerXMLHTTP
 objSvrHTTP.Open "GET", "http://www.google.com"
 objSvrHTTP.setRequestHeader "Accept", "application/xml"
 objSvrHTTP.setRequestHeader "Content-Type", "application/xml"
 objSvrHTTP.Send strT
 If err = 0 Then
 checkInternetConnection = True
 Else
  MsgBox "Internet connection not estableshed: " & err.Description & "", 64, "Additt !"
 End If
End Function

Answer 4

Основываясь на ответе шакальпеша и комментариях к нему, есть (как минимум) два способа вставить веб-страницу в Word без анализа XML, возвращаемого объектом XMLHTTP60.

(Примечание: код состояния HTTP 200 означает, что «запрос успешно выполнен» - см. здесь )

• записать XMLHTTP60.ResponseText в текстовый файл и затем вызвать Documents.Open для этого текстового файла

If (xhr.Status = 200) Then
    hOutFile = FreeFile
    Open "C:\foo.html" For Output As #hOutFile
    Print #hOutFile, xhr.responseText
    Close #hOutFile
End If

// ...

Documents.Open "C:\foo.html"

Это имеет тот недостаток, что некоторые связанные элементы могут быть потеряны, и вы получите сообщение при открытии файла

• проверьте статус URL с помощью объекта XMLHTTP60, а затем используйте Documents.Open, чтобы открыть URL-адрес, как и раньше:

If (xhr.Status = 200) Then
    Documents.Open "http://foo.bar.com/index.html"
End If

Существует небольшая вероятность того, что запрос XMLHTTP60 может быть выполнен успешно, а Documents.Open один завершится ошибкой (или наоборот). Надеюсь, это должно быть довольно необычное событие, хотя

Answer 5

К сожалению, на этот вопрос сложно ответить по нескольким причинам:

1. Как вы определяете нерабочее подключение к интернету? Вы проверяете действительный IP-адрес? Вы пингуетесь? Откуда вы знаете, что у вас есть права на проверку этих вещей? Откуда вы знаете, что брандмауэр / антивирус компьютера не вызывает сомнительного поведения?
2. Как только вы установили, что соединение работает, что вы будете делать, если соединение разорвано в середине работы?

Возможно, есть способы сделать то, что вы хотите сделать, но многие вещи типа "дьявол в деталях" имеют тенденцию появляться Есть ли у вас способ проверить, что сохраненный поиск действителен? Если это так, это, вероятно, будет лучшим способом сделать это.

Answer 6

Это то, что я использую. Я предпочитаю это, потому что это не требует никаких внешних ссылок или DLL.

Public Function IsConnected()
    Dim objFS As Object
    Dim objShell As Object
    Dim objTempFile As Object
    Dim strLine As String
    Dim strFileName As String
    Dim strHostAddress As String
    Dim strTempFolder As String

    strTempFolder = "C:\PingTemp"
    strHostAddress = "8.8.8.8"
    IsConnected = True ' Assume success
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Wscript.Shell")

    If Dir(strTempFolder, vbDirectory) = "" Then
      MkDir strTempFolder
    End If

    strFileName = strTempFolder & "\" & objFS.GetTempName
    If Dir(strFileName) <> "" Then
      objFS.DeleteFile (strFileName)
    End If

    objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
    Set objTempFile = objFS.OpenTextFile(strFileName, 1)
    Do While objTempFile.AtEndOfStream <> True
        strLine = objTempFile.Readline
        If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
            IsConnected = False
        End If
    Loop
    objTempFile.Close
    objFS.DeleteFile (strFileName)
    objFS.DeleteFolder (strTempFolder)

    ' Remove this after testing.  Function will return True or False
    MsgBox IsConnected
End Function

Answer 7

Я нашел большинство ответов здесь и в других местах сбивающими с толку или неполными, поэтому вот как это сделать для таких идиотов, как я:

'paste this code in at the top of your module (it will not work elsewhere)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20

'paste this code in anywhere
Function IsInternetConnected() As Boolean
    Dim L As Long
    Dim R As Long
    R = InternetGetConnectedState(L, 0&)
    If R = 0 Then
        IsInternetConnected = False
    Else
        If R <= 4 Then IsInternetConnected = True Else IsInternetConnected = False

    End If
End Function

'your main function/calling function would look something like this
Private Sub btnInternetFunction_Click()
    If IsInternetConnected() = True Then
        MsgBox ("You are connected to the Internet")
        'code to execute Internet-required function here
    Else
        MsgBox ("You are not connected to the Internet or there is an issue with your Internet connection.")
    End If
End Sub