VBScriptで友達の書いた1つの内ネットで投票するプログラムを手伝います
最近友达の要求に応じて、VBScriptで投票の小さいプログラムを书いて、いくつかのものはふだん使ったことがなくて本当に知らないで、忘れることを防止するために、Blogの中で覚えて、良い记忆性はぼろぼろの笔头に及ばないですか.
Function randNum()
result = -1
For ii=0 To 10
While (result<1 or result>3)
result = round(( Rnd() * 30 / 10 ))
WEnd
Next
randNum = result
End Function
Function RndNumber(min, max)
Randomize()
result = -1
While (result<min Or result>max)
result = Int( Rnd() * (max - min + 1) ) + min
Wend
RndNumber = result
End Function
Function ChangeIP(ip, netMask)
' IP
'strIPAddress=Array("192.168.1.43")
strIPAddress=Array(ip)
'
strSubnetMask=Array(netMask)
'
'DefaultIPGateway=Array("192.168.1.1")
'
'GatewayCostMetric=Array("1")
' DNS
'DNSServer = Array("61.139.44.38", "61.139.2.69")
strComputer="." '
Set objWMIService=GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters=objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each objNetAdapter in colNetAdapters
' IP
errEnable=objNetAdapter.EnableStatic(strIPAddress, strSubnetMask)
'
'errEnable=objNetAdapter.SetGateways(DefaultIPGateway,GatewayCostMetric)
' DNS
'errEnable=objNetAdapter.SetDNSServerSearchOrder(DNSServer)
Next
ChangeIP = true
End Function
Function makeQuery
Dim str
str = ""
For ii=1 To 10
str = str & ii & "="
If ii=4 Then
str = str & "11"
Else
str = str & (randNum() + (ii - 1) * 3)
End If
If ii<10 Then str = str & "&"
Next
str = str & "&sss.x=150&sss.y=35"
makeQuery = str
End Function
'MsgBox makeQuery
Dim xmlhttp
Function SendRequest(url, queryString)
'define vars
'url = "http://sheng.iteye.com"
'MsgBox "URL = " & url & "?" & queryString
txtfile.WriteLine( queryString )
'Exit Function
'make request
xmlhttp.open "POST", url, False
xmlhttp.setRequestHeader "Content-length", Len(queryString)
xmlhttp.setRequestHeader "Accept","image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*"
xmlhttp.setRequestHeader "Referer","http://X.X.X.X/fjltpoll/poll_intro.asp"
xmlhttp.setRequestHeader "Accept-Language","zh-cn"
xmlhttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
xmlhttp.setRequestHeader "Accept-Encoding","gzip, deflate"
xmlhttp.setRequestHeader "User-Agent","Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Maxthon; .NET CLR 1.1.4322)"
xmlhttp.setRequestHeader "Host","X.X.X.X"
xmlhttp.setRequestHeader "Connection","Keep-Alive"
xmlhttp.setRequestHeader "Cache-Control","no-cache"
xmlhttp.setRequestHeader "Cookie","ASPSESSIONIDAQADASTQ=PJNHMBADPFKJBHDNBJGELLEL"
xmlhttp.setRequestHeader "Content-Type","text/html;charset=GB2312"
xmlhttp.send queryString
'wait for response
xmlhttp.waitForResponse()
'if status is 200, then it's OK
if xmlhttp.status = 200 then
'WScript.Echo xmlhttp.responseText
txtfile.WriteLine( Bytes2BSTR(xmlhttp.responseBody ))
else
'popup bad response, or just omit to end
'WScript.Echo("bad response")
txtfile.WriteLine( "bad response" )
end if
'destroy objects. I'm not sure this is necessary
'Set xmlhttp = Nothing
End Function
Dim url
url = "http://X.X.X.X/fjltpoll/vote.asp"
Dim logFile, fso, txtfile
logFile = "C:\vote_log.txt"
Function Bytes2BSTR( vIn )
Dim strReturn
strReturn = ""
For i =1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
Bytes2BSTR = strReturn
End Function
Sub InitObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.OpenTextFile(logFile, 2, True)
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
End Sub
Sub ReleaseObject
txtfile.close
Set txtfile = Nothing
Set fso = Nothing
Set xmlhttp = Nothing
End Sub
Function Vote()
Dim subIPs, sleepTime
MsgBox " "
InitObject
subIPs = Split(IPs, ",")
For ii=0 To UBound(subIPs)
IP = IPprefix & subIPs(ii) ' IP
sleepTime = RndNumber(sleepTimeMin, sleepTimeMax) * 1000 '
txtfile.WriteLine( "IP=" & IP & ", SleepTime=" & sleepTime & " ms") '
ChangeIP IP, netMask
qStr = makeQuery()
SendRequest url, qStr
WScript.sleep( sleepTime )
Next
ReleaseObject
MsgBox " "
End Function
'==*************************************************==
'
'==-------------------------------------------------==
Dim IPprefix, fromIP, toIP, netMask, IPs
Dim sleepTimeMin, sleepTimeMax ' / ( )
IPprefix = "X.X.32." 'IP
'fromIP = 1 ' IP
'toIP = 5 ' IP
IPs = "1,3,2,5,4" 'IP
netMask = "255.255.248.0" '
sleepTimeMin = 10
sleepTimeMax = 60
'
Vote()