如何时时知道,网络是不时连通?

Question

要做一个知道网络是不是连通的功能,自己是这样作的:
Function GetStatus(ByVal sUrl As String, ByVal myinet As Inet) As Integer
Err.Clear
Dim bRet As Integer, sLen As String
Dim oInet As Inet
Dim strBuffer As String
'*******************************************************
'*******************************************************
'***************bRet代表类型的错误**********************
'0 代表登陆成功            1 代表密码或帐号有错误
'2 代表没有可以使用的时间  3 代表还没有分配时间
'*******************************************************
'*******************************************************
On Error Resume Next
bRet = 100
strBuffer = ""
Set oInet = myinet
bIsTest = True
oInet.Execute sUrl, "GET"
Do While oInet.StillExecuting = True
    DoEvents
    Sleep 1
Loop
bIsTest = False
strBuffer = oInet.GetChunk(1024)
'MsgBox strBuffer
If Err Then
    bRet = 1 '代表帐号和密码不正确
    Err.Clear
Else
    If strBuffer = "ok" Then
        bRet = 0
    End If
    If strBuffer = "off" Then
        bRet = 2
    End If    If strBuffer = "err" Then
        bRet = 1
    End If
End IfGetStatus = bRetEnd FunctionPrivate Sub Timer2_Timer()
Dim strRet, URL
    URL = "http://yourpp.w91.22cn.net.cn/checkNet.asp"
    strRet = GetNetStatus(URL, Main.Inet2)
    'MsgBox strRet
    If strRet = 0 Then
        Main.Timer2.Interval = 10000
        'MsgBox strRet
    Else
        strRet = GetNetStatus(URL, Main.Inet2)
        If strRet = 0 Then
            Main.Timer2.Interval = 10000
        Else
            MsgBox "网络没有连通，请检查网络！连通后再重启！"
            End
        End If
    End If       
     
End Sub
不知道是怎么回事?
在有的机器上,这个代码很好用,只要网络一断,就提示
可是在有些机器上,断开网络10分钟了,还没有提示,
请问怎么解决?
有没有更好的方法?
谢谢

Answer 1

Dim m_bolComplete As Boolean
Dim m_bolError  As BooleanPrivate Sub Command1_Click()
    m_bolComplete = False
    m_bolError = False
    WebBrowser1.Navigate2 "news.sohu.com"
    
    While Not m_bolComplete
        DoEvents
    Wend
    
    MsgBox IIf(m_bolError, "未连网", "已连网")
End SubPrivate Sub Form_Load()
    WebBrowser1.Navigate2 "about:blank"
End SubPrivate Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    m_bolComplete = True
End SubPrivate Sub WebBrowser1_NavigateError(ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
    m_bolError = True
End Sub