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

Узнай цену своей работы

Формулировка задачи:

Сказать, что тема избитая - не сказать ничего ) Есть три способа: 1. Через АПИ RASEnum.... - приемлемо только для dial-up 2. Через АПИ GetConnectedState (или что-то в этом роде) - скажет, что вы в Сети, даже если вы просто в локалке 3. Через АПИ-функции из wininet.dll (попытка открыть любой корректный URL) - тупит по-страшному. Короче говоря, ни одного нормального способа ( Последний - самый надёжный в плане результата: если пинговать Yahoo, то т.к. эта служба никогда не 'падает' (по кр. мере верим в это), то мы точно (99.9%) будем знать - в Сети мы или нет. Только вот если в программе делать такую проверочку из АПИ-таймера, скажем раз в 5-10 секунд, то если ничего в программе в этот момент не делать, то можно жить, - а вот если момент проверки коннекта попадёт на открытие popup-меню, то у меня даже Win2000 пишет, что 'Программа не отвечает'!!! ну а менюха 'замораживается'... есть и другие похожие бяки. Выносить в отдельный поток? (так руки и не дошли до этого; на VBNET.RU, кстати, все почему-то очень ругали использование CreateThread под VB...) Выносить в отдельный EXE-шник (на худой конец)? который бы жил сам по себе, просто результат проверки через SendMessage периодически пулял бы в главное окно. Ещё как? Главное - чтоб не 'тупило'.

Решение задачи: «Нужен не тормозной способ определения коннекта к Сети»

textual
Листинг программы
'
' §§§§§§§§§§§§§§§§§§§§§§§§§§§ В модуль: §§§§§§§§§§§§§§§§§§§§§§§§§§§
'
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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 3.818 из 5
Похожие ответы