將下面的代碼，直接保存為getproxy.vbs即可。

代碼如下:

'1、輸入url目標(biāo)網(wǎng)頁(yè)地址，返回值getHTTPPage是目標(biāo)網(wǎng)頁(yè)的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)頁(yè)得到的將是亂瑪，可以通過(guò)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 class=" & """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 " 沒(méi)有了",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