Нужен не тормозной способ определения коннекта к Сети - 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
Листинг программы
  1. '
  2. ' §§§§§§§§§§§§§§§§§§§§§§§§§§§ В модуль: §§§§§§§§§§§§§§§§§§§§§§§§§§§
  3. '
  4. Option Explicit
  5. '
  6. ' Все API-декларации опускаю для краткости
  7. '
  8. Public timerID As Long, params() As String
  9. '
  10. Sub Main()
  11.     Dim i As Integer
  12.    
  13.     App.TaskVisible = False
  14.    
  15.     If App.PrevInstance Then Exit Sub
  16.     If Len(Command$) = 0 Then Exit Sub
  17.     ' через командную строку передаётся следующая информация (через pipe-символ):
  18.    ' 1-й параметр: хэндл статус-бара
  19.    ' 2 параметр: номер панели статус-бара
  20.    ' 3-й параметр: текст для он-лайна
  21.    ' 4 параметр: хэндл иконки для он-лайна
  22.    ' 5-й параметр: текст для офф-лайна
  23.    ' 6 параметр: хэндл иконки для офф-лайна
  24.    ' 7-й параметр: частота проверки коннекта (мс)
  25.    ' 8 параметр: ID вызывающего процесса
  26.    
  27.     params = Split(Command$, '|')
  28.    If Not (LBound(params) = 0 And UBound(params) = 7) Then Exit Sub
  29.    
  30.     For i = 0 To 7
  31.         If i = 2 Or i = 4 Then
  32.             ' это строковые параметры
  33.            If Len(Trim$(params(i))) = 0 Then Exit Sub
  34.         Else
  35.             ' это строковое представление Long-параметров
  36.            If Not IsNumeric(params(i)) Then Exit Sub
  37.         End If
  38.     Next
  39.    
  40.     SetThreadPriority GetCurrentThread, THREAD_PRIORITY_BELOW_NORMAL
  41.     SetPriorityClass GetCurrentProcess, IDLE_PRIORITY_CLASS
  42.    
  43.     Load frmMain
  44.    
  45. End Sub
  46. '
  47. Public Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
  48.    
  49.     ' сначала проверяем, что вызывающее приложение ещё 'живо':
  50.    If IsWindow(CLng(params(0))) = 0 Then
  51.         KillTimer 0, timerID
  52.         Unload frmMain
  53.         End
  54.     End If
  55.    
  56.     If CheckInternetConnection Then
  57.         SendMessage CLng(params(0)), SB_SETICON, 0, ByVal CLng(params(3))
  58.         WriteStatusText CLng(params(7)), CLng(params(0)), CLng(params(1)), params(2)
  59.     Else
  60.         SendMessage CLng(params(0)), SB_SETICON, 0, ByVal CLng(params(5))
  61.         WriteStatusText CLng(params(7)), CLng(params(0)), CLng(params(1)), params(4)
  62.     End If
  63.    
  64. End Sub
  65. '
  66. Public Sub WriteStatusText(ByVal callerPID As Long, ByVal stbarHwnd As Long, _
  67.                            ByVal panelIndex As Long, ByVal msgText As String)
  68.    
  69.     Dim hProcess As Long, pMem As Long, w As Long
  70.    
  71.     ' Открываем процесс с правами записи и чтения:
  72.    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, callerPID)
  73.     ' Если не получилось - выходим:
  74.    If hProcess = 0 Then Exit Sub
  75.     ' Резервируем кусок памяти в контексте процесса:
  76.    pMem = VirtualAllocEx(hProcess, ByVal 0, ByVal (Len(msgText) + 256), MEM_COMMIT, PAGE_READWRITE)
  77.     If pMem <> 0 Then
  78.         ' если получилось, то копируем строку в память процесса:
  79.        WriteProcessMemory hProcess, ByVal pMem, ByVal msgText, Len(msgText), w
  80.         ' посылаем сообщение статус-бару:
  81.        Call SendMessage(stbarHwnd, SB_SETTEXT, panelIndex, ByVal pMem)
  82.         ' Освобождаем память:
  83.        VirtualFreeEx hProcess, ByVal pMem, 1024, MEM_RELEASE
  84.     Else
  85.         ' Сюда попадаем, если не удалось выделить память:
  86.        '' MsgBox 'Cannot allocate memory in context of selected process...', vbCritical, 'Error'
  87.    End If
  88.     ' Закрываем процесс:
  89.    CloseHandle hProcess
  90.  
  91. End Sub
  92. '
  93. Private Function CheckInternetConnection() As Boolean
  94.     Dim hInet As Long
  95.     Dim hUrl As Long

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


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

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

11   голосов , оценка 3.818 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы