十年网站开发经验 + 多家企业客户 + 靠谱的建站团队
量身定制 + 运营维护+专业推广+无忧售后,网站问题一站解决
新建工程,加入一模块,代码如下:
创新互联建站坚持“要么做到,要么别承诺”的工作理念,服务领域包括:网站设计、做网站、企业官网、英文网站、手机端网站、网站推广等服务,满足客户于互联网时代的翠屏网站设计、移动媒体设计的需求,帮助企业找到有效的互联网解决方案。努力成为您成熟可靠的网络建设合作伙伴!
Option Explicit
Public isolerr As Boolean
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
'
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
'
Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'
Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal 0 Then
MsgBox "出现错误!", vbCritical + vbDefaultButton1 + vbOKOnly, "错误!"
Form1.wangluozhuangkuang.Visible = False
isolerr = True
Exit Function
End If
'
isolerr = False
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = H2000 Then
IsConnected = True
Else
IsConnected = False
End If
End Function
在窗体中添加一记时器(Timer),代码如下:
Private Sub Timer1_Timer()
checkonline
End Sub
然后在通用声明中添加如下代码
Sub checkonline()
If isolerr = False Then
If IsConnected = True Then
wangluozhuangkuang.Caption = "已经连接网络"
Else
wangluozhuangkuang.Caption = "尚未连接网络"
End If
End If
End Sub
最后在窗体上添加一Label,名字为wangluozhuangkuang
不懂再问我
你这段代码可以获得该主机名下的所有ip,每个ip地址都是有类型簇的,可以区别本地地址和网络地址、ip6地址。
你获取索引为0的ip,不一定是正确的网络地址,它有时顺序在中间,在后面。
应该获取所有ip,再通过ip地址簇类型区分
判断连接本身有一个函数,不过有时没联网也是真。
可以用ping,ping百度、ping访问速度快、不经常维护断线的网络主机。
Microsoft.VisualBasic.Devices.Network.IsAvailable As Boolean
生成实例后可以通过此属性来获取是否联网的值,True代表已联网,False代表没有联网
Microsoft.VisualBasic.Devices.Network.NetworkAvailabilityChanged(ByVal Object, ByVal Microsoft.VisualBasic.Devices.NetworkAvailableEventArgs)
该事件是在电脑断开/连上互联网是引发的
其中:
e.IsNetworkAvailable
的功能同Microsoft.VisualBasic.Devices.Network.IsAvailable
实例:
Dim netListener As New Microsoft.VisualBasic.Devices.Network '生成实例
If netListener.IsAvailable = True Then
MsgBox("已联网")
Else
MsgBox("未联网")
End If
NetworkAvailabilityChanged实例:
WithEvents netListener As New Microsoft.VisualBasic.Devices.Network '生成实例
Private Sub OnNetworkChanged(ByVal Object, ByVal Microsoft.VisualBasic.Devices.NetworkAvailableEventArgs)Handles netListener.NetworkAvailabilityChanged
If e.IsNetworkAvailable = True Then
MsgBox("已联网")
Else
MsgBox("未联网")
End If
End Sub
新建模块
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 正常