vb检测网络连接

A. vb怎么查看电脑是否连接到网络

GetHostbyNameAPI可获取域名对应的IP地址,当没有联网状态将会返回一个错误值。所以可利用它来判断是否联网。

PrivateSubForm_Load()
IfIsConnectedStateThen
MsgBox"连接网络"
Else
MsgBox"没有联网"
EndIf
EndSub

VBScriptcode复制代码

OptionExplicit

PrivateTypeWSADATA
wversionAsInteger
wHighVersionAsInteger
szDescription(0To256)AsByte
szSystemStatus(0To128)AsByte
iMaxSocketsAsInteger
iMaxUdpDgAsInteger
lpszVendorInfoAsLong
EndType

"WSOCK32.DLL"(,lpWSADataAsWSADATA)AsLong
"WSOCK32.DLL"()AsLong
"WSOCK32.DLL"(ByValszHostnameAsString)AsLong
PrivateConstWS_VERSION_REQD=&H101

()AsBoolean
DimudtWSADAsWSADATA
CallWSAStartup(WS_VERSION_REQD,udtWSAD)
IsConnectedState=CBool(gethostbyname("www..com"))
CallWSACleanup
EndFunction

B. vb 如何检测网络连接

这个我以前做过，用的是pingsql数据库服务器的ip，当ping实现的，把程序给你参考下，要是有什么更好的办法，不要忘了分享下，这种东西很有用
把下面的放模块
Option Explicit
Public Const IP_STATUS_BASE = 11000
Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)
Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public Const IP_PENDING = (11000 + 255)
Public Const PING_TIMEOUT = 200
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1

Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128

Public Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type

Dim ICMPOPT As ICMP_OPTIONS

Public Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
data As String * 250
End Type

Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Public Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type

Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Public Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long

Public Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
ByVal RequestOptions As Long, _
ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Declare Function gethostname Lib "WSOCK32.DLL" _
(ByVal szHost As String, _
ByVal dwHostLen As Long) As Long

Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal szHost As String) As Long

Public Declare Sub RtlMoveMemory Lib "kernel32" _
(hpvDest As Any, _
ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public strtempht1, strtempht2, strtempht3, strtempht4, strtempht5, strtempht6 As String, f%, Cfg$, my$, up$

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Function GetStatusCode(status As Long) As String

Dim msg As String

'Message Boxes
Select Case status
Case IP_SUCCESS: msg = "IP Successful"
Case IP_BUF_TOO_SMALL: msg = "IP Buffer Too Small"
Case IP_DEST_NET_UNREACHABLE: msg = "IP Destination Net Unreachable"
Case IP_DEST_HOST_UNREACHABLE: msg = "IP Destination Host Unreachable"
Case IP_DEST_PROT_UNREACHABLE: msg = "IP Destination Protocol Unreachable"
Case IP_DEST_PORT_UNREACHABLE: msg = "IP Destination Port Unreachable"
Case IP_NO_RESOURCES: msg = "IP No Resources"
Case IP_BAD_OPTION: msg = "IP Bad Option"
Case IP_HW_ERROR: msg = "IP Hw Error"
Case IP_PACKET_TOO_BIG: msg = "IP Packet Too Big"
Case IP_REQ_TIMED_OUT: msg = "IP currently timed out"
Case IP_BAD_REQ: msg = "IP Bad Request"
Case IP_BAD_ROUTE: msg = "IP Bad Route"
Case IP_TTL_EXPIRED_TRANSIT: msg = "IP ttl expired transit"
Case IP_TTL_EXPIRED_REASSEM: msg = "IP ttl expired reassem"
Case IP_PARAM_PROBLEM: msg = "IP Parameter Problem"
Case IP_SOURCE_QUENCH: msg = "IP Source Quench"
Case IP_OPTION_TOO_BIG: msg = "IP Option too Big"
Case IP_BAD_DESTINATION: msg = "IP Bad Destination"
Case IP_ADDR_DELETED: msg = "IP addr deleted"
Case IP_SPEC_MTU_CHANGE: msg = "IP Spec Mtu Change"
Case IP_MTU_CHANGE: msg = "IP Mtu Change"
Case IP_UNLOAD: msg = "IP Unload"
Case IP_ADDR_ADDED: msg = "IP Address Added"
Case IP_GENERAL_FAILURE: msg = "IP General Failure"
Case IP_PENDING: msg = "IP Pending"
Case PING_TIMEOUT: msg = "Ping Timeout"
Case Else: msg = "Unknown Message Returned!"
End Select

GetStatusCode = CStr(status) & " [ " & msg & " ]"

End Function

Public Function HiByte(ByVal wParam As Integer)

HiByte = wParam \ &H100 And &HFF&

End Function

Public Function LoByte(ByVal wParam As Integer)

LoByte = wParam And &HFF&

End Function

Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long

Dim hPort As Long
Dim dwAddress As Long
Dim sDataToSend As String
Dim iOpt As Long

sDataToSend = "Echo This"
dwAddress = AddressStringToLong(szAddress)

Call SocketsInitialize
hPort = IcmpCreateFile()

If IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
0, _
ECHO, _
Len(ECHO), _
PING_TIMEOUT) Then
Ping = ECHO.RoundTripTime
Else: Ping = ECHO.status * -1
End If

Call IcmpCloseHandle(hPort)
Call SocketsCleanup

End Function
Function AddressStringToLong(ByVal tmp As String) As Long
Dim i As Integer
Dim parts(1 To 4) As String

i = 0

While InStr(tmp, ".") > 0
i = i + 1
parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
tmp = Mid(tmp, InStr(tmp, ".") + 1)
Wend

i = i + 1
parts(i) = tmp

If i <> 4 Then
AddressStringToLong = 0
Exit Function
End If

AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & _
Right("00" & Hex(parts(3)), 2) & _
Right("00" & Hex(parts(2)), 2) & _
Right("00" & Hex(parts(1)), 2))

End Function
Public Function SocketsCleanup() As Boolean
Dim x As Long
x = WSACleanup()
If x <> 0 Then
MsgBox "Windows Sockets error " & Trim$(Str$(x)) & _
" occurred in Cleanup.", vbExclamation
SocketsCleanup = False
Else
SocketsCleanup = True
End If
End Function
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim x As Integer
Dim szLoByte As String, szHiByte As String, szBuf As String
x = WSAStartup(WS_VERSION_REQD, WSAD)

If x <> 0 Then
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
SocketsInitialize = False
Exit Function
End If

If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

szHiByte = Trim$(Str$(HiByte(WSAD.wVersion)))
szLoByte = Trim$(Str$(LoByte(WSAD.wVersion)))
szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
szBuf = szBuf & " is not supported by Windows " & _
"Sockets for 32 bit Windows environments."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
szBuf = "This application requires a minimum of " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If

SocketsInitialize = True
End Function

在timer控件中放：
Private Sub Timer_Timer()

Dim timeS As Double
Dim ECHO As ICMP_ECHO_REPLY
Dim s As String
s = Form2.ip.Text
Call Ping(s, ECHO)
If ECHO.status <> IP_SUCCESS Then
Form1.WindowState = 0
Form1.Show
Form6.Show
End If

End Sub
看代码你也能看出来，timer中的Form2.ip.Text就是你要ping的ip地址
Form1.WindowState = 0
Form1.Show
Form6.Show就是当网络不通的时候执行的代码，你自己看看。

C. 如何用VB代码判断计算机是否连接到Internet

VB 检测是否连接到Internet以及通过何种方式（Modem,LAN,Proxy）连接

'模块代码:

Public 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

Public Enum EIGCInternetConnectionState
INTERNET_CONNECTION_MODEM = &H1&
INTERNET_CONNECTION_LAN = &H2&
INTERNET_CONNECTION_PROXY = &H4&
INTERNET_RAS_INSTALLED = &H10&
INTERNET_CONNECTION_OFFLINE = &H20&
INTERNET_CONNECTION_CONFIGURED = &H40&
End Enum

Public Property Get InternetConnected( _
Optional ByRef eConnectionInfo As EIGCInternetConnectionState, _
Optional ByRef sConnectionName As String _
) As Boolean
Dim dwFlags As Long
Dim sNameBuf As String
Dim lR As Long
Dim iPos As Long

sNameBuf = String$(513, 0)
lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
eConnectionInfo = dwFlags
iPos = InStr(sNameBuf, vbNullChar)
If iPos > 0 Then
sConnectionName = Left$(sNameBuf, iPos - 1)
ElseIf Not sNameBuf = String$(513, 0) Then
sConnectionName = sNameBuf
End If
InternetConnected = (lR = 1)
End Property

'窗体代码:
Dim eR As EIGCInternetConnectionState
Dim sMsg As String
Dim sName As String
Dim bConnected As Boolean

Private Sub Command1_Click()
bConnected = InternetConnected(eR, sName)

If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
sMsg = sMsg & "Connection uses a modem." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
sMsg = sMsg & "Connection uses LAN." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
sMsg = sMsg & "Connection is via Proxy." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
sMsg = sMsg & "Connection is Off-line." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
sMsg = sMsg & "Connection is Configured." & vbCrLf
Else
sMsg = sMsg & "Connection is Not Configured." & vbCrLf
End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
sMsg = sMsg & "System has RAS installed." & vbCrLf
End If

If bConnected Then
Text1.Text = "Connected: " & sName & vbCrLf & vbCrLf & sMsg
Else
Text1.Text = "Not Connected: " & sName & vbCrLf & vbCrLf & sMsg
End If
End Sub

D. VB检测网络状态

'请试看这个 添加 Command1 修改下面你要检测的IP地址

Private Sub Command1_Click()
MsgBox IIf(CheckServ("192.168.1.1"), "服务器联线中", "服务器未联线") '你的服务器IP地址
End Sub

Public Function CheckServ(Ipadr As String) As Boolean
Dim aa$, bb$, fname$
CheckServ = False
fname = "c:\tmpfile.txt"
Open "c:\testip.bat" For Output As #1
Print #1, "@echo off"
Print #1, "ping " & Ipadr & " > " & fname
Close #1
If Dir(fname) <> "" Then Kill fname
Call Shell("cmd /c " & "c:\testip.bat", vbHide)
'延时5秒内是否得到文档
starttm = Timer
Do
DoEvents
If Dir(fname) <> "" Then
If FileLen(fname) > 10 Then Exit Do '得到文档即退出检测
End If
Loop Until Timer > = starttm + 5
bb = ""
If Dir(fname) <> "" Then
Open fname For Input As #1
While Not EOF(1)
Line Input #1, aa
bb = bb & aa & vbCrLf
Wend
Close #1
End If
CheckServ = IIf(InStr(bb, "Request") > 0, False, True)
If Dir("c:\testip.bat") <> "" Then Kill "c:\testip.bat"
End Function

E. vb怎样查看网络连接状态

Winsock.state 是显示当前Winsock 和另一主机连接的状态,它不是显示主机网络信息的.

用InternetGetConnectedState() 函数可以实现.为了方便你调用下面给模快代码你吧..

Private Declare Function InternetGetConnectedState Lib "Wininet.dll" (ByVal Flag As Long, ByVal Reserved As Long) As Long
Public Type Rtn_InetStat
IsConnecting As Boolean
IsModenConnecting As Boolean
IsModenBusy As Boolean
IsLANConnecting As Boolean
IsProxyConnecting As Boolean
End Type
Public Function RtnInetStat() As Rtn_InetStat
RtnInetStat.IsConnecting = RtnNunBooleanA(InternetGetConnectedState(0, 0))
RtnInetStat.IsModenConnecting = RtnNunBooleanB(InternetGetConnectedState(1, 0))
RtnInetStat.IsLANConnecting = RtnNunBooleanB(InternetGetConnectedState(2, 0))
RtnInetStat.IsProxyConnecting = RtnNunBooleanA(InternetGetConnectedState(4, 0))
RtnInetStat.IsModenBusy = RtnNunBooleanA(InternetGetConnectedState(8, 0))
End Function
Private Function RtnNunBooleanA(ByVal Num As Long) As Boolean
If Num = 0 Then
RtnNunBooleanA = False
Else
RtnNunBooleanA = True
End If
End Function
Private Function RtnNunBooleanB(ByVal Num As Long) As Boolean
If Num = 0 Then
RtnNunBooleanB = True
Else
RtnNunBooleanB = False
End If
End Function

获取当前网络是否已连接上:
Msgbox RtnInetStat.IsConnecting

F. VB怎么检查网络连接状态

如果是检查winsock的连接状态可以用，if winsock1.state=*
sckClosed 0 缺省的。关闭
sckOpen 1 打开
sckListening 2 侦听
sckConnectionPending 3 连接挂起
sckResolvingHost 4 识别主机
sckHostResolved 5 已识别主机
sckConnecting 6 正在连接
sckConnected 7 已连接
sckClosing 8 同级人员正在关闭连接
sckError 9 错误

*值得就是上述值的一个，然后在后面添加代码！例如要判断时候关闭，就可以
if winsock1.state=0 then msgbox "未连接!"
这样的没有连接就会弹出对话框了

G. 想用VB作做一个网络连接的诊断问题

Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Public Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
Public Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long

Public Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
Data As String * 250
End Type

Function AddressStringToLong(ByVal tmp As String) As Long
Dim i As Integer
Dim parts(1 To 4) As String
i = 0
While InStr(tmp, ".") > 0
i = i + 1
parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1)
tmp = Mid(tmp, InStr(tmp, ".") + 1)
Wend
i = i + 1
parts(i) = tmp
If i <> 4 Then
AddressStringToLong = 0
Exit Function
End If
AddressStringToLong = Val("&H" & Right("00" & Hex(parts(4)), 2) & Right("00" & Hex(parts(3)), 2) & Right("00" & Hex(parts(2)), 2) & Right("00" & Hex(parts(1)), 2))
End Function

Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long
Dim hPort As Long
Dim dwAddress As Long
Dim sDataToSend As String
sDataToSend = "My Request"
dwAddress = AddressStringToLong(szAddress)
hPort = IcmpCreateFile()
If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), 0, ECHO, Len(ECHO), 4000) Then
'Ping如果成功,Status返回0,RoundTripTime是Ping完成的时间,单位为Ms,Data是返回的数据,Address是接受响应的Ip地址,DataSize是接受数据,Data的大小.
Ping = ECHO.RoundTripTime
Else: Ping = ECHO.status * -1
End If
Call IcmpCloseHandle(hPort)
End Function

’‘请将上面内容放入一个模块

'在窗体上放一个command调用

Private Sub Command1_Click()
Dim ECHO As ICMP_ECHO_REPLY
Ping "192.168.0.1", ECHO

If ECHO.Status = 0 Then
MsgBox "网络是通的 "
Else
MsgBox "网络是不通的"
End If

End Sub
这是我使用的 供你参考 字体红绿 自己做吧 如有疑问 联系我

H. vb.net中如何判断网络连接

新建模块
Function IsHearOK(ByVal URL As String) As Boolean '判断网页是否存在函数
Dim XMLObject As Object, ReturnType As String
XMLObject = CreateObject("Microsoft.XMLHTTP")
XMLObject.Open("GET", URL, False)
XMLObject.setRequestHeader("CONTENT-TYPE", "application/x-www-form-urlencoded")
XMLObject.setRequestHeader("Range", "bytes=1-255")
Try
XMLObject.Send()
If XMLObject.Status = 200 Or XMLObject.Status = 206 Then
ReturnType = XMLObject.getResponseHeader("CONTENT-TYPE")
If UCase(ReturnType) <> "TEXT/HTML" Then
IsHearOK = True
Else
IsHearOK = False
End If
Else
IsHearOK = False

End If
Catch
MsgBox("连接异常，请检查网络！", , "提醒")
XMLObject = Nothing

End Try
End Function

调用 ishearok（url）=true 正常

I. vb怎么判断网络是否已经连接上

GetHostbyName API可获取域名对应的IP地址,当没有联网状态将会返回一个错误值。所以可利用它来判断是否联网。

Private Sub Form_Load()
If IsConnectedState Then
MsgBox "连接网络"
Else
MsgBox "没有联网"
End If
End Sub

VBScript code复制代码

Option Explicit

Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To 256) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type

Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As String) As Long
Private Const WS_VERSION_REQD = &H101

Public Function IsConnectedState() As Boolean
Dim udtWSAD As WSADATA
Call WSAStartup(WS_VERSION_REQD, udtWSAD)
IsConnectedState = CBool(gethostbyname("www..com"))
Call WSACleanup
End Function