Страница: 1 |
|
Вопрос: Узнать о связи с Инетом
|
Добавлено: 28.08.04 15:12
|
|
Автор вопроса: dNW
|
Как узнать, есть ли в данный момент связь с Internet'ом.
IsNetworkAlive глючит в вин98
Ответить
|
Номер ответа: 4 Автор ответа: Kodo
Разработчик Offline Client
ICQ: 293048085
Вопросов: 37 Ответов: 457
|
Профиль | | #4
|
Добавлено: 28.08.04 17:05
|
3 способа :
[code]
Private Sub CheckConnection1()
Dim ReturnCode As Long
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0)
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
MsgBox "Your computer is not connected to Internet via modem", vbInformation, "Checing connection"
Else
MsgBox "Your computer is connected to Internet via modem", vbInformation, "Checing connection"
End If
Else
MsgBox "Your computer is not connected to Internet via modem, but it can be connected via LAN", vbInformation, "Checing connection"
End If
End If
RegCloseKey (hKey)
End Sub
Private Sub CheckConnection2(Optional ByRef ConnectionInfo As Long, Optional ByRef sConnectionName As String)
Dim dwFlags As Long
Dim sNameBuf As String, msg As String
Dim lPos As Long
sNameBuf = String$(513, 0)
If InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&) Then
lPos = InStr(sNameBuf, vbNullChar)
If lPos > 0 Then
sConnectionName = Left$(sNameBuf, lPos - 1)
Else
sConnectionName = ""
End If
msg = "Your computer is connected to Internet" & vbCrLf & "Connection Name: " & sConnectionName
If (dwFlags And INTERNET_CONNECTION_LAN) Then
msg = msg & vbCrLf & "Connection use LAN"
ElseIf lFlags And INTERNET_CONNECTION_MODEM Then
msg = msg & vbCrLf & "Connection use modem"
End If
If lFlags And INTERNET_CONNECTION_PROXY Then msg = msg & vbCrLf & "Connection use Proxy"
If lFlags And INTERNET_RAS_INSTALLED Then
msg = msg & vbCrLf & "RAS INSTALLED"
Else
msg = msg & vbCrLf & "RAS NOT INSTALLED"
End If
If lFlags And INTERNET_CONNECTION_OFFLINE Then
msg = msg & vbCrLf & "You are OFFLINE"
Else
msg = msg & vbCrLf & "You are ONLINE"
End If
If lFlags And INTERNET_CONNECTION_CONFIGURED Then
msg = msg & vbCrLf & "Your connection is Configured"
Else
msg = msg & vbCrLf & "Your connection is not Configured"
End If
Else
msg = "Your computer is NOT connected to Internet"
End If
MsgBox msg, vbInformation, "Checking connection"
End Sub
Private Sub CheckConnection3()
Dim sTmp As String
Dim hInet As Long
Dim hUrl As Long
Dim Flags As Long
Dim url As Variant
hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
sTmp = Me.Caption
Me.Caption = "Checking connection with www.yahoo.com..."
If hInet Then
Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, Flags, 0)
If hUrl Then
MsgBox "Your computer is connected to Internet", vbInformation, "Checing connection"
Call InternetCloseHandle(hUrl)
Else
MsgBox "Your computer is not connected to Internet", vbInformation, "Checing connection"
End If
End If
Call InternetCloseHandle(hInet)
Me.Caption = sTmp
End Sub
[/code]
ВНИМАНИЕ !
Первый способ только для модема.
Второй всегда вернет True, если у вас есть сеть.
Третий - это просто Ping. Ессно, если у чела файрwall и он запретит выход проге в инет - False, False...
Ответить
|
Номер ответа: 5 Автор ответа: Kodo
Разработчик Offline Client
ICQ: 293048085
Вопросов: 37 Ответов: 457
|
Профиль | | #5
|
Добавлено: 28.08.04 17:06
|
Ой, апишки забыл.
'Working with registry declarations and constants
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const APINULL = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
'Working with wininet.dll declarations and constants
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long 'Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long 'this function used with IE4
'Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long 'this function used with IE4
Private Const INTERNET_CONNECTION_MODEM = &H1&
Private Const INTERNET_CONNECTION_LAN = &H2&
Private Const INTERNET_CONNECTION_PROXY = &H4&
Private Const INTERNET_RAS_INSTALLED = &H10&
Private Const INTERNET_CONNECTION_OFFLINE = &H20&
Private Const INTERNET_CONNECTION_CONFIGURED = &H40&
'Declares for direct ping
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Dim checkType As Integer
Dim remMsg(2) As String
Ответить
|
Страница: 1 |
Поиск по форуму