Attribute VB_Name = "PublicMod"
' *************  網絡測速器 ***************
' 作者:~蝸牜尐籽~ QQ:45524562
' 郵箱:cs_xing@21cn.com

' ********************* 網頁處理模塊 *********************
Option Explicit

Public Type aLink
    txt As String
    href As String
End Type

Public WebPathUrl As String '測速網頁路徑
Public NowWebSped As Double '測試完的速度
Public SnailErr As Boolean

Public snLinks() As aLink, snInput(1) As String

'函數名稱  : GetString(字符串,字符串A,字符串B)
'舉    例  : GetString("<td>1234567890</td>","<td>","</td>") ===> "1234567890"
'作    用  : 獲取固定字符串 在字符串A與B之間的字符
Public Function GetString(ByVal snStr As String, ByVal FstStr As String, ByVal SecStr As String) As String     '取兩字符串間的字符串
    Dim FstLen As Long, SecLen As Long, MaxLen As Long
    Dim FstNum As Long, SecNum As Long, NowNum As Long
    Dim MidStr As String, tmp As String
    
    FstLen = Len(FstStr)
    SecLen = Len(SecStr)
    MaxLen = Len(snStr)
    NowNum = 1
On Error GoTo ErrMsg:
'開始查找中間字符串
    While NowNum <= MaxLen
        FstNum = InStr(NowNum, snStr, FstStr) '獲取第1個字符位置
        SecNum = InStr(FstNum + FstLen + 1, snStr, SecStr) '獲取第2個字符位置
        
        If SecNum = 0 Or FstNum = 0 Then Exit Function
        
        MidStr = Mid(snStr, FstNum + FstLen, SecNum - FstNum - FstLen)
        NowNum = SecNum + SecLen
        tmp = "&nbsp;|<br>|<BR>|<SPAN class=text_hui>|</SPAN>|<A class=A03 title=如果此地址信息不對，請點這里注冊。。。 href=" & Chr(34) & "http://www.linkwan.com/gb/broadmeter/VisitorInfo/RigisterIP.htm" & Chr(34) & " target=_Blank>|" & _
              "</A>|<td>|</td>|<TD>|</TD>|" & vbCrLf & "|上傳速度溫度計|" & _
              "<font style=" & Chr(34) & "font-size: 14pt" & Chr(34) & " face=" & Chr(34) & "Arial" & Chr(34) & " color=" & Chr(34) & "#FF00FF" & Chr(34) & ">"
        MidStr = RpNum(Trim(MidStr), tmp)
        MidStr = RpNum(MidStr, "&gt;", ">")
        MidStr = RpNum(MidStr, "&lt;", "<")
        GetString = GetString & MidStr & " "
        DoEvents
    Wend
    Exit Function
ErrMsg:
    Err.Clear
    GetString = "獲取失敗"
End Function
'函數名稱  : GetWebLink(瀏覽控件,網頁帶有的字符串)
'舉    例  : GetWebLink(snWeb,"SpeedTest.asp")
'作    用  : 獲取網頁內的超級連接
Public Function GetWebLink(ByVal snWeb As Object, Optional SearchStr As String = "")
On Error GoTo ErrMsg:
Dim vDoc As Object, vTag As Object
Dim i As Long, Num As Integer, tmp() As aLink
    Set vDoc = snWeb.Document
    Num = 0
    ReDim tmp(vDoc.All.length - 1) As aLink
    For i = 0 To vDoc.All.length - 1
        If LCase(vDoc.All(i).tagName) = "a" Then
            Set vTag = vDoc.All(i)
            If InStrRev(LCase(vTag.href), LCase(SearchStr)) > 0 Then
                tmp(Num).href = vTag.href
                tmp(Num).txt = vTag.innerHTML
                Num = Num + 1
            End If
        End If
        DoEvents
    Next i
ReDim snLinks(Num - 1) As aLink
For i = 0 To UBound(tmp)
    If tmp(i).txt <> Empty Then snLinks(i) = tmp(i)
    DoEvents
Next i
Exit Function
ErrMsg:
    Err.Clear
    SnailErr = True
    Num = MsgBox("互聯網資源不可用！本程序即將關閉！" & vbCrLf & "是否關閉？", 36, "獲取信息")
    If Num = 6 Then End
End Function
'函數名稱  : Hex2Chr()
'舉    例  : Hex2Chr("%B8%A3%BD%A8%CF%C3%C3%C5%28%CF%C3%C3%C5%BA%A3%C3%CB%BF%C6%BC%BC%D3%D0%CF%DE%B9%AB%CB%BE%29")
'作    用  : 將網頁字符串轉成文字       '福建廈門(廈門海盟科技有限公司)
Public Function Hex2Chr(ByVal snChr As String)
Dim i As Integer, tmp() As String, Stp As Integer
Dim StrCont As String, ChrNum As Long
Dim ErrStr As String
    StrCont = ""
    tmp = Split(snChr, "%") '獲取數組大小
    i = 1
    While i <= UBound(tmp)
        If i >= UBound(tmp) Then '判斷是否溢出
            ChrNum = Val("&h" & Left(tmp(i - 1), 2))
        Else
            ChrNum = Val("&h" & Left(tmp(i), 2) & Left(tmp(i + 1), 2))
        End If
        If ChrNum > 0 Then '如果是英文
            If Len(tmp(i)) > 2 Then '判斷當前的字符是否帶有其它符號
                ErrStr = Mid(tmp(i), 3, Len(tmp(i)) - 2)
            Else
                ErrStr = ""
            End If
            StrCont = StrCont & Chr(Val("&h" & Left(tmp(i), 2))) & ErrStr
            Stp = 1
        Else                '如果是中文字符
            If Len(tmp(i + 1)) > 2 Then '判斷當前的字符是否帶有其它符號
                ErrStr = Mid(tmp(i + 1), 3, Len(tmp(i + 1)) - 2)
            Else
                ErrStr = ""
            End If
            StrCont = StrCont & Chr(ChrNum) & ErrStr
            Stp = 2
        End If
        i = i + Stp
        DoEvents
    Wend
    Hex2Chr = StrCont
End Function

'函數名稱  : RpNum()
'舉    例  : RpNum("<br><BR>","<br>|</td>")
'作    用  : 過濾多個字符串
Public Function RpNum(ByVal snChr As String, ByVal snSpt As String, Optional reSpt As String = "") As String
    Dim sptNum() As String, i As Integer
    Dim sptTmp As String
        sptTmp = snChr
        sptNum = Split(snSpt, "|")
        For i = 0 To UBound(sptNum)
            sptTmp = Replace(sptTmp, sptNum(i), reSpt)
        Next i
            RpNum = sptTmp
End Function