Нужен не тормозной способ определения коннекта к Сети - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д