Case 0
        cmdMin.Visible = True
        cmdExit.Visible = False
        cmdMax.Visible = False
    Case 1
        cmdMax.Visible = True
        cmdExit.Visible = False
        cmdMin.Visible = False
    Case 2
        cmdExit.Visible = True
        cmdMin.Visible = False
        cmdMax.Visible = False
    End Select
End Sub

Private Sub cmdExit_Click()
    Unload Me '退出按鈕按下
    End
End Sub

Private Sub cmdMax_Click()
    'If Button = 1 Then Me.WindowState = vbMaximized '最大化按鈕按下
End Sub

Private Sub cmdMin_Click()
    Me.WindowState = vbMinimized '最小化按鈕按下
End Sub

' *************  網(wǎng)絡(luò)測(cè)速器 ***************
' 作者:~蝸牜尐籽~ QQ:45524562
' 郵箱:cs_xing@21cn.com

' ********************* 主程序 *********************
Private Sub Form_Load()
Dim i As Integer, WindowRegion As Long
'初始化數(shù)據(jù)
    WebPathUrl = "http://www.linkwan.com/gb/broadmeter/SpeedAuto/"
    NowWebSped = 0
    snTestWeb.Navigate WebPathUrl
    snTest.Navigate "about:blank"
'自定義窗口數(shù)據(jù)
    Me.ScaleMode = vbPixels
    Me.AutoRedraw = True
    Me.BorderStyle = vbBSNone
      '調(diào)用自定義函數(shù)
      'WindowRegion = MakeRegion(Me)
      '矩形窗口改變?yōu)閳D片形狀窗口
      'SetWindowRgn Me.hwnd, WindowRegion, True
'窗體比例對(duì)齊
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 4

With MoveFrm
    .Caption = "":          .BackStyle = 0
    .Top = 1:               .Left = 0
    .Width = Me.ScaleWidth: .Height = 30
End With
'頂部按鈕初始化設(shè)置
With cmdButon(0)
    .Top = 10: .Left = 425
    .Caption = "": .BackStyle = 0
End With
With cmdButon(1)
    .Top = 10: .Left = 445
    .Caption = "": .BackStyle = 0
End With
With cmdButon(2)
    .Top = 10: .Left = 465
    .Caption = "": .BackStyle = 0
End With
'系統(tǒng)按鈕初始化設(shè)置
    cmdMin.Top = 10:  cmdMin.Left = 425:  cmdMin.Visible = False
    cmdMax.Top = 10:  cmdMax.Left = 445:  cmdMax.Visible = False
    cmdExit.Top = 10: cmdExit.Left = 465: cmdExit.Visible = False
'站點(diǎn)列表初始化設(shè)置
For i = 0 To 29
    With List(i)
        .Visible = False
        .ForeColor = &H80000002
        .MouseIcon = cmdMin.MouseIcon
        .MousePointer = 99
    End With
Next i
'翻頁按鈕初始化設(shè)置
With MoveP
    .Visible = False
    .MouseIcon = cmdMin.MouseIcon
    .MousePointer = 99
End With
With MoveN
    .Visible = False
    .MouseIcon = cmdMin.MouseIcon
    .MousePointer = 99
End With
'網(wǎng)速顯示初始化設(shè)置
With imNumKbps(0)
    .Stretch = True
    .Visible = False
    .Top = 228
    .Left = 424
End With
With imNumKbps(1)
    .Stretch = False
    .Visible = False
    .Top = 228
    .Left = 424
End With
'關(guān)于按鈕初始化設(shè)置
about.MouseIcon = cmdMin.MouseIcon
about.MousePointer = 99
'數(shù)據(jù)初始化設(shè)置
lbOK.Visible = False
tmCheck.Enabled = False '暫時(shí)沒有用
vbPageNum = 0
PcNum = 0
snPCNum = 0
SnailErr = False
End Sub
'鼠標(biāo)在窗體移動(dòng)時(shí)還原默認(rèn)數(shù)值
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
    cmdExit.Visible = False
    cmdMin.Visible = False
    cmdMax.Visible = False
For i = 0 To 29
    List(i).ForeColor = &H80000002
Next i
End Sub
'點(diǎn)擊了測(cè)試站點(diǎn)
Private Sub List_Click(Index As Integer)
If SnailErr Then Exit Sub
Dim tmp As String, i As Integer
PcNum = 0
    tmp = GetString(snLinks(vbPageNum * 30 + Index).href, "=", "=")
    tmp = Replace(tmp, "u", "")
    lblNowPC.Caption = "狀態(tài):正在測(cè)試站點(diǎn)==>>" & Hex2Chr(Mid(tmp, 1, Len(tmp) - 2))
    NowWebTitle = List(Index).Caption & " ==>> " & Hex2Chr(Mid(tmp, 1, Len(tmp) - 2))
    snTest.Navigate snLinks(vbPageNum * 30 + Index).href
    For i = 0 To 5
        listMsg(i).ForeColor = &H404040
        listMsg(i).Caption = "正在獲取數(shù)據(jù)"
    Next i
    Debug.Print snLinks(vbPageNum * 30 + Index).href
End Sub
'測(cè)試站點(diǎn)列表特效
Private Sub List_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    For i = 0 To 29
        If Index = i Then
            List(i).ForeColor = &HFF&
        Else
            List(i).ForeColor = &H80000002
        End If
    Next i
End Sub

'一種無標(biāo)題欄窗口移動(dòng)的方法
Private Sub MoveFrm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ReleaseCapture    '釋放窗口中的鼠標(biāo)輸入
  '發(fā)送模擬鼠標(biāo)拖曳窗口標(biāo)題欄的消息
  SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

Private Sub MoveFrm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdExit.Visible = False
    cmdMin.Visible = False
    cmdMax.Visible = False
End Sub
'翻頁 下一頁
Private Sub MoveN_Click()
If SnailErr Then Exit Sub
Dim i As Integer, pNum As Integer
'裝載網(wǎng)頁數(shù)據(jù)
    vbPageNum = IIf(vbPageNum >= Int(UBound(snLinks) / 30), Int(UBound(snLinks) / 30), vbPageNum + 1)
For i = 0 To 29
    If UBound(snLinks) < i Then
        List(i).Visible = False
    Else
        If i + vbPageNum * 30 > UBound(snLinks) Then
            List(i).Visible = False
        Else
            List(i).Visible = True
            List(i).Caption = snLinks(i + vbPageNum * 30).txt
        End If
    End If
Next i
    lblPageNum.Caption = Format(vbPageNum + 1, "00") & Space(12) & Format(UBound(snLinks), "000") & Space(8) & "30"
End Sub
'翻頁 上一頁
Private Sub MoveP_Click()
If SnailErr Then Exit Sub
Dim i As Integer
'裝載網(wǎng)頁數(shù)據(jù)
    vbPageNum = IIf(vbPageNum <= 0, 0, vbPageNum - 1)
For i = 0 To 29
    If UBound(snLinks) < i Then
        List(i).Visible = False
    Else
        List(i).Visible = True
        List(i).Caption = snLinks(i + vbPageNum * 30).txt
    End If
Next i
    lblPageNum.Caption = Format(vbPageNum + 1, "00") & Space(12) & Format(UBound(snLinks), "000") & Space(8) & "30"
End Sub

'測(cè)試站點(diǎn)下載完成時(shí) 處理數(shù)據(jù)
Private Sub snTest_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If SnailErr Then Exit Sub
    'snTest.Document.documentelement.outerhtml
Dim tmp As String, i As Integer
    PcNum = PcNum + 1
    If PcNum > 2 Then
        tmp = snTest.Document.body.innerHTML
        For i = 0 To 4
            listMsg(i).ForeColor = &H404040
        Next i
        listMsg(5).ForeColor = &H8000&
        listMsg(0).Caption = GetString(tmp, "IP：", "來自：")
        listMsg(1).Caption = GetString(tmp, "來自：", "操作系統(tǒng)：")
        listMsg(2).Caption = GetString(tmp, "操作系統(tǒng)：", "瀏 覽 器：")
        listMsg(3).Caption = GetString(tmp, "瀏 覽 器：", "測(cè)試時(shí)間：")
        listMsg(4).Caption = GetString(tmp, "測(cè)試時(shí)間：", "<BR>&nbsp;</TD>")
        listMsg(5).Caption = Trim(GetString(tmp, "<B>", "</B>")) & "kbps"
        snPCNum = Val(Split(listMsg(5).Caption, " ")(0))
        Call CheckKbps
        imNumKbps(0).Visible = True
        imNumKbps(1).Visible = True
        lbOK.Visible = True
        lbOK.ForeColor = &HC0&
        lbOK.Caption = "測(cè)試完畢"
        Open IIf(Right(App.Path, 1) <> "\", App.Path & "\測(cè)試記錄.ini", App.Path & "測(cè)試記錄.ini") For Append As #1
            Print #1, NowWebTitle & " 速度:" & listMsg(5).Caption
        Close #1
        NowWebTitle = ""
        DoEvents
    Else
        If InStrRev(TitleText, "無法找到該頁") > 0 Then
            For i = 0 To 5
                listMsg(i).ForeColor = &HFF&
                listMsg(i).Caption = "無法獲取數(shù)據(jù)"
            Next i
            lbOK.Visible = True
            lbOK.ForeColor = &HFF&
            lbOK.Caption = "測(cè)試失敗"
        ElseIf tmp = Empty And PcNum <= 1 Then
            For i = 0 To 5
                listMsg(i).Caption = "加載數(shù)據(jù)中."
            Next i
            lbOK.Visible = True
            lbOK.ForeColor = &HC0&
            lbOK.Caption = "測(cè)試完成"
        End If
    End If
End Sub

'測(cè)試站點(diǎn)正在下載時(shí) 觸發(fā)進(jìn)度條
Private Sub snTest_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
Dim tmpNum As Integer
    If (Progress <> -1 And Progress <> 0) And Progress <= ProgressMax Then
        tmpNum = Progress / ProgressMax * 900
        lblPC.Width = IIf(tmpNum > 136, 136, tmpNum)
        'Debug.Print Progress / ProgressMax * 1000 & "%"
        If PcNum <= 2 Then
            snPCNum = Rnd() * 2100
            Call CheckKbps
            imNumKbps(0).Visible = True
            imNumKbps(1).Visible = True
            lbOK.Visible = True
            lbOK.ForeColor = &H80000002
            lbOK.Caption = "正在測(cè)試"
        End If
        DoEvents
    End If
End Sub
'獲取網(wǎng)頁標(biāo)題
Private Sub snTest_TitleChange(ByVal Text As String)
    TitleText = Text
End Sub
'測(cè)試主站點(diǎn)下載完成時(shí) 處理數(shù)據(jù)
Private Sub snTestWeb_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim i As Integer
    Call GetWebLink(snTestWeb, "SpeedTest.asp")
If SnailErr Then GoTo ErrMsg:
    lblMsgLink.Visible = False
'裝載網(wǎng)頁數(shù)據(jù)
For i = 0 To 29
    If UBound(snLinks) < i Then
        List(i).Visible = False
    Else
        List(i).Visible = True
        List(i).Caption = snLinks(i).txt
    End If
    DoEvents
Next i
    For i = 0 To 5
        listMsg(i).Caption = "Null"
    Next i
    lblPageNum.Caption = Format(vbPageNum + 1, "00") & Space(12) & Format(UBound(snLinks), "000") & Space(8) & "30"
    tmLinks.Enabled = False
ErrMsg:
    MoveP.Visible = True
    MoveN.Visible = True
    lblNowPC.Caption = "狀態(tài)：數(shù)據(jù)連接完成，請(qǐng)選擇要測(cè)試的站點(diǎn)！"
End Sub

Private Sub tmLinks_Timer()
    lblMsgLink.Caption = lblMsgLink.Caption & "."
    lblNowPC.Caption = lblNowPC.Caption & "."
    If Len(lblMsgLink.Caption) >= 11 Then lblMsgLink.Caption = "數(shù)據(jù)連接中."
    If Len(lblNowPC.Caption) >= 21 Then lblNowPC.Caption = "狀態(tài)：初始化完成，正在數(shù)據(jù)連接."
End Sub

'函數(shù)名稱  : CheckKbps()
'舉    例  : CheckKbps(1200.12)
'作    用  : 獲取Kbps值的高度
Public Function CheckKbps()
If SnailErr Then Exit Function
Dim Min As Integer, Max As Integer
    Min = 70: Max = 310
    Select Case snPCNum
     Case Is <= 20
        DoEvents
     Case Is <= 60
        imNumKbps(1).Top = Max - snPCNum / 20 * 15
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is <= 100
        imNumKbps(1).Top = Max - snPCNum / 40 * 15 - 22
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is <= 200
        imNumKbps(1).Top = Max - snPCNum / 50 * 15 - 27
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is <= 500
        imNumKbps(1).Top = Max - snPCNum / 150 * 15 - 65
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is <= 2000
        imNumKbps(1).Top = Max - snPCNum / 250 * 15 - 80
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is <= 3000
        imNumKbps(1).Top = Max - snPCNum / 500 * 15 - 137
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
     Case Is > 3000
        imNumKbps(1).Top = 70
        imNumKbps(0).Top = imNumKbps(1).Top + imNumKbps(1).Height
        imNumKbps(0).Height = Max - imNumKbps(1).Height - imNumKbps(0).Top
        DoEvents
    End Select
End Function