vbs 搜索代理地址實(shí)現(xiàn)代碼

    將下面的代碼，直接保存為getproxy.vbs即可。
    代碼如下:
    '1、輸入url目標(biāo)網(wǎng)頁地址，返回值getHTTPPage是目標(biāo)網(wǎng)頁的html代碼
    function getHTTPPage(url)
    dim Http
    set Http=CreateObject("MSXML2.XMLHTTP")
    Http.open "GET",url,false
    Http.send()
    if Http.readystate<>4 then
    exit function
    end if
    getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
    set http=nothing
    if err.number<>0 then err.Clear
    end function
    '2、轉(zhuǎn)換亂瑪，直接用xmlhttp調(diào)用有中文字符的網(wǎng)頁得到的將是亂瑪，可以通過adodb.stream組件進(jìn)行轉(zhuǎn)換
    Function BytesToBstr(body,Cset)
    dim objstream
    set objstream =CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.Mode = 3
    objstream.Open
    objstream.Write body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = Cset
    BytesToBstr = objstream.ReadText
    objstream.Close
    set objstream = nothing
    End Function
    '下面試著調(diào)用http://www.proxycn.com/html_proxy/30fastproxy-1.html的html內(nèi)容
    Dim Url,Html,Temp
    Url="http://www.proxycn.com/html_proxy/30fastproxy-1.html"
    Html = getHTTPPage(Url)
    Call getinfo(html)
    Sub Getinfo(S)
    Dim pl(),m,St
    St="</TD><TD""list""" & ">"
    Do
    m = m + 1
    n = P + Len(St)
    P = InStr(n,S,St)
    ReDim Preserve pl(m-1)
    pl(m-1) = P
    loop While P <> 0
    For o = 0 to m-1
    If o+1 < m-1 Then
    T_S=Mid(S,pl(o)+Len(St),pl(o+1)-pl(o)-Len(St))
    If Len(T_S) < 30 Then
    t=t+1
    Select Case t
    Case 1
    temp = temp & "端口 : " & T_S & vbcrlf
    Case 2
    temp = temp & "類型 : " & T_S & vbcrlf
    Case 3
    temp = temp & "地址 : " & T_S & vbcrlf
    Case 4
    temp = temp & "時(shí)間 : " & Now & vbcrlf
    Case 5
    t=0
    Str_Sip = "whois.php?whois="
    Str_Eip = "target=_blank>whois</TD></TR>"
    n1 = P_Sip + Len(Str_Sip)
    P_Sip = InStr(n1,S,Str_Sip)
    n2 = P_Eip + Len(Str_Eip)
    P_Eip = InStr(n2,S,Str_Eip)
    Ip=Mid(S,P_Sip+Len(Str_Sip),P_Eip-P_Sip-Len(Str_Sip))
    If PingIp(Ip) = 1 Then
    temp = temp & "IP : " & Ip & vbcrlf
    If MsgBox (temp,vbyesno,"是否繼續(xù)? " )=vbno Then
    WScript.quit
    End If
    End If
    temp = ""
    End Select
    End If
    Else
    MsgBox " 沒有了",vbokonly,"提示"
    WSCript.quit
    End If
    Next
    End Sub
    Function PingIp(host)
    On Error Resume Next
    strComputer = "."
    strTarget = host
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colPings = objWMIService.ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & strTarget & "'")
    If Err = 0 Then
    Err.Clear
    For Each objPing in colPings
    If Err = 0 Then
    Err.Clear
    If objPing.StatusCode = 0 Then
    PingIp = 1
    temp = temp & "速度 : " & objPing.ResponseTime & " 毫秒" & vbcrlf
    'MsgBox strTarget & " responded to ping." & vbcrlf &_
    '"Responding Address: " & objPing.ProtocolAddress & vbcrlf &_
    '"Responding Name: " & objPing.ProtocolAddressResolved & vbcrlf &_
    '"Bytes Sent: " & objPing.BufferSize & vbcrlf &_
    '"Time: " & objPing.ResponseTime & " ms" & vbcrlf &_
    '"TTL: " & objPing.ResponseTimeToLive & " seconds"
    Else
    PingIp = 0
    'MsgBox strTarget & " did not respond to ping." &_
    '"Status Code: " & objPing.StatusCode
    End If
    Else
    Err.Clear
    PingIP = 0
    'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "."
    End If
    Next
    Else
    Err.Clear
    PingIp = 0
    'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "."
    End If
    End Function