Нужен не тормозной способ определения коннекта к Сети

'
' §§§§§§§§§§§§§§§§§§§§§§§§§§§ В модуль: §§§§§§§§§§§§§§§§§§§§§§§§§§§
'
Option Explicit
'
' Все API-декларации опускаю для краткости
'
Public timerID As Long, params() As String
'
Sub Main()
    Dim i As Integer
    
    App.TaskVisible = False
    
    If App.PrevInstance Then Exit Sub
    If Len(Command$) = 0 Then Exit Sub
    ' через командную строку передаётся следующая информация (через pipe-символ):
    ' 1-й параметр: хэндл статус-бара
    ' 2-й параметр: номер панели статус-бара
    ' 3-й параметр: текст для он-лайна
    ' 4-й параметр: хэндл иконки для он-лайна
    ' 5-й параметр: текст для офф-лайна
    ' 6-й параметр: хэндл иконки для офф-лайна
    ' 7-й параметр: частота проверки коннекта (мс)
    ' 8-й параметр: ID вызывающего процесса
    
    params = Split(Command$, '|')
    If Not (LBound(params) = 0 And UBound(params) = 7) Then Exit Sub
    
    For i = 0 To 7
        If i = 2 Or i = 4 Then
            ' это строковые параметры
            If Len(Trim$(params(i))) = 0 Then Exit Sub
        Else
            ' это строковое представление Long-параметров
            If Not IsNumeric(params(i)) Then Exit Sub
        End If
    Next
    
    SetThreadPriority GetCurrentThread, THREAD_PRIORITY_BELOW_NORMAL
    SetPriorityClass GetCurrentProcess, IDLE_PRIORITY_CLASS
    
    Load frmMain
    
End Sub
'
Public Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    
    ' сначала проверяем, что вызывающее приложение ещё 'живо':
    If IsWindow(CLng(params(0))) = 0 Then
        KillTimer 0, timerID
        Unload frmMain
        End
    End If
    
    If CheckInternetConnection Then
        SendMessage CLng(params(0)), SB_SETICON, 0, ByVal CLng(params(3))
        WriteStatusText CLng(params(7)), CLng(params(0)), CLng(params(1)), params(2)
    Else
        SendMessage CLng(params(0)), SB_SETICON, 0, ByVal CLng(params(5))
        WriteStatusText CLng(params(7)), CLng(params(0)), CLng(params(1)), params(4)
    End If
    
End Sub
'
Public Sub WriteStatusText(ByVal callerPID As Long, ByVal stbarHwnd As Long, _
                           ByVal panelIndex As Long, ByVal msgText As String)
    
    Dim hProcess As Long, pMem As Long, w As Long
    
    ' Открываем процесс с правами записи и чтения:
    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, callerPID)
    ' Если не получилось - выходим:
    If hProcess = 0 Then Exit Sub
    ' Резервируем кусок памяти в контексте процесса:
    pMem = VirtualAllocEx(hProcess, ByVal 0, ByVal (Len(msgText) + 256), MEM_COMMIT, PAGE_READWRITE)
    If pMem <> 0 Then
        ' если получилось, то копируем строку в память процесса:
        WriteProcessMemory hProcess, ByVal pMem, ByVal msgText, Len(msgText), w
        ' посылаем сообщение статус-бару:
        Call SendMessage(stbarHwnd, SB_SETTEXT, panelIndex, ByVal pMem)
        ' Освобождаем память:
        VirtualFreeEx hProcess, ByVal pMem, 1024, MEM_RELEASE
    Else
        ' Сюда попадаем, если не удалось выделить память:
        '' MsgBox 'Cannot allocate memory in context of selected process...', vbCritical, 'Error'
    End If
    ' Закрываем процесс:
    CloseHandle hProcess
 
End Sub
'
Private Function CheckInternetConnection() As Boolean
    Dim hInet As Long
    Dim hUrl As Long