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