yu2n

VBS 调用 Msxml2.ServerXMLHTTP 获取网页上的地址信息

' getIP.vbs
Msgbox "外网IP为：" & getIP()

Function getIP()
    Dim strHtml, strIP
    If strIP = "" Then
        strHtml = HttpGet("http://yu2n.sinaapp.com/app/f/ip/AddIP.php?ip=show_client")
        strIP = Join(regEx_execute("\d+\.\d+\.\d+\.\d+", strHtml))
    End If
    If strIP = "" Then
        strHtml = HttpGet("http://iframe.ip138.com/ic.asp")
        strIP = Join(regEx_execute("\d+\.\d+\.\d+\.\d+", strHtml))
    End If
    If strIP = "" Then
        strHtml = HttpGet("http://www.whereismyip.com/")
        strIP = Join(regEx_execute("\d+\.\d+\.\d+\.\d+", strHtml))
    End If
    getIP = strIP
End Function

Function HttpGet(ByVal url)
    With CreateObject("Msxml2.ServerXMLHTTP")
        .open "GET", url, False
        .send
        HttpGet = .responseText
    End With
End Function

' ====================================================================================================
' 检查字符串是否符合正则表达式
'Msgbox Join(regEx_execute( "[A-z]", "a-v d-f b-c"), " | ")
'Msgbox regEx_replace( "[A-z]+-[A-z]+", "a-v d-f b-c", " | ")
' 取得正则表达式搜索结果，返回数组
Function regEx_execute(ByVal sPattern, ByVal str)
    Dim regEx, Match, Matches, arrMatchs(), i : i = -1    ' 建立变量。
    Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。
        regEx.Pattern = sPattern      ' 设置模式。
        regEx.IgnoreCase = True    ' 设置是否区分字符大小写。
        regEx.Global = True        ' 设置全局可用性。
        regEx.MultiLine = True     ' 多行匹配模式
    Set Matches = regEx.Execute(str)      ' 执行搜索。
    For Each Match in Matches  ' 遍历匹配集合。
        If Not Match.Value = "" Then
            i = i + 1
            ReDim Preserve arrMatchs(i) ' 动态数组：数组随循环而变化
            arrMatchs(i) = Match.Value
        End If
    Next
    regEx_execute = arrMatchs
	Set Match = Nothing
	Set regEx = Nothing
End Function
复制代码