Vbs search proxy address implementation code [thief program]

CopyCode Code: '1. Enter the URL address of the target webpage. The returned value gethttppage is the HTML code of the target webpage.
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. If you use XMLHTTP to call a webpage with Chinese characters, you can use the ADODB. Stream component to convert the webpage.
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

'Next, try to call the HTML content of http://www.proxycn.com/html_proxy/30fastproxy-1.html.
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 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 & "port:" & t_s & vbcrlf
Case 2
Temp = temp & "type:" & t_s & vbcrlf
Case 3
Temp = temp & "Address:" & t_s & vbcrlf
Case 4
Temp = temp & "time:" & 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, "Continue? ") = Vbno then
Wscript. Quit
End if
End if
Temp = ""
End select
End if
Else
Msgbox "no", vbokonly, "prompt"
Wscript. Quit
End if
Next
End sub

Function pingip (host)
On Error resume next
Strcomputer = "."
Strtarget = Host
Set ob1_miservice = GetObject ("winmgmts :"_
& "{Impersonationlevel = impersonate }! \ "& Strcomputer &" \ Root \ cimv2 ")
Set colpings = ob1_miservice. 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 & "Speed:" & objping. responsetime & "millisecond" & 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