Dim HttpID,AppName,CNZZ_User,CNZZ_Password
HttpID = 0
AppName = "app_51.la_demo"
La51_User = "myw3demo"
La51_Password = "la51test"
Function OpenHttp(byval url,byval PostData,byref strlocation)
dim xmlhttp,xmlget,bgpos,endpos,sendtype,imgtype,isbinstr
HttpID = HttpID + 1
if HttpID > 10 then
response.write "1,連接次數(shù)過多"
response.end
end if
strlocation = ""
sendtype = "SENDTYPE=GET"
imgtype = "GETTYPE=IMAGE"
isbinstr = false
Set xmlhttp = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
xmlhttp.Option(6)=0
With xmlhttp
.setTimeouts 200000,200000,200000,200000
if left(PostData,len(sendtype)) = sendtype or left(PostData,len(imgtype)) = imgtype then
if left(PostData,len(sendtype)) = sendtype then
url = url & "?" & replace(PostData,sendtype,"")
else
url = url & "?" & replace(PostData,imgtype,"")
isbinstr = true
end if
PostData = ""
.Open "GET", url , False
else
.Open "POST", url, False
end if
.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
.setRequestHeader "Content-Length",Len(PostData)
.setRequestHeader "Referer"," If Application(AppName & "APIOPcookie")<>"" Then .setRequestHeader "COOKIE", Application(AppName & "APIOPcookie")
.Send PostData
If InStr(LCase(.GetAllResponseHeaders),"location:") Then
strlocation = .GetResponseHeader("location")
end if
If InStr(.GetAllResponseHeaders,"Set-Cookie") Then
Application(AppName & "APIOPcookie") = getAJiangCookies(.GetAllResponseHeaders)
End If
if isbinstr then
xmlget = .responseBody
else
xmlget = bin2str(.responseBody)
end if
End With
set xmlhttp = nothing
OpenHttp = xmlget
End Function
Function bin2str(byval binstr)
Const adTypeBinary = 1
Const adTypeText = 2
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
With BytesStream
.Type = adTypeText
.Open
.WriteText binstr
.Position = 0
.Charset = "GB2312"
.Position = 2
StringReturn = .ReadText
.close
End With
Set BytesStream = Nothing
bin2str = StringReturn
End Function
Function getAJiangCookies(byval strHeader)
dim tmp,ltmp,sck
tmp = ""
sck = "Set-Cookie:"
for each ltmp in split(strHeader,vbCrlf)
if left(ltmp,len(sck)) = sck then
if tmp <> "" then tmp = tmp & ";"
ltmp = mid(ltmp,len(sck) + 2)
tmp = tmp & split(ltmp,"; ")(0)
end if
next
tmp = tmp & "; expires=Tue, 23-Sep-2014 16:00:00 GMT; path=/"
getAJiangCookies = tmp
End Function
Function OpenRegExp(byref re)
if not isobject(re) then
set re = new RegExp
re.ignorecase = true
re.global = true
end if
End Function
Function NotLink(byval Html)
call OpenRegExp(re)
Html = replace(Html,"</a>","")
re.pattern = "<a([^<]*)>"
Html = re.replace(Html,"")
NotLink = Html
End Function
function notImage(byval Html)
call OpenRegExp(re)
re.pattern = "<img([^<]*)>"
Html = re.replace(Html,"")
notImage = Html
end function
Function midtrim(byval s)
s = trim(s)
s = replace(s," ","")
for k = 0 to 50
s = replace(s," "," ")
next
midtrim = s
End Function
Function Connect(byval act,byval str)
dim html
if strlocation = "../login.asp" then
response.redirect "?act=login"
elseif strlocation <> "" then
Connect = strlocation
else
Connect = html
end if
End Function
Sub getCode()
dim html
Response.Expires = -9999
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
Response.ContentType = "Image/BMP"
response.binarywrite Connect("user/vcode","GETTYPE=IMAGE")
End Sub
Sub Main()
dim html,pe,pa,pm,re,ra,rm
html = Connect("user/index","SENDTYPE=GETall=yes")
html = notImage(html)
html = notLink(html)
Call OpenRegExp(re)
Call OpenRegExp(ra)
Call OpenRegExp(rm)
re.pattern = "[\S\s]*點(diǎn)擊“查看統(tǒng)計(jì)報(bào)表”可查看實(shí)時(shí)數(shù)據(jù)。"
ra.pattern = "\( 合計(jì)當(dāng)前顯示的[\S\s]*"
rm.pattern = "<div class=""sitelist_o"">[^<]*</div>"
set pe = re.execute(html)
set pa = ra.execute(html)
set pm = rm.execute(html)
if pe.count = 0 or pa.count = 0 or pm.count = 0 then
else
html = re.replace(html,"")
html = ra.replace(html,"")
html = rm.replace(html,"")
html = "<div>" & html & "</div>"
Call MainUI(html)
end if
End Sub
Sub Login()
dim html
html = "<form action=""?act=dologin"" method=""POST"">" & _
"第一次訪問的時(shí)候，需要輸入驗(yàn)證碼：" & _
"<input name=""vcode"" size=""4"" />" & _
" <img src=""?act=getcode&timer=" & timer() & """ /> " & _
"<input type=""submit"" value=""提交""/>" & _
"</form>"
Call MainUI(html)
End Sub
Sub doLogin()
dim html,vcode,sendStr
vcode = request("vcode")
sendStr = "uname=" & La51_User & _
"&upass=" & La51_Password & _
"&vcode=" & vcode & _
"&remb=yes"
html = Connect("login",sendStr)
if html = "user/" then
response.redirect "?act=list"
elseif instr(html,"驗(yàn)證碼不正確") then
Call MainUI("<a href=""?act=login"">驗(yàn)證碼不正確，請重新登錄</a>")
else
Call MainUI("<a href=""?act=login"">賬號(hào)或密碼錯(cuò)誤，請修改配置并重新登錄</a>")
end if
End Sub
Sub MainUI(byval body)
dim html
body = midtrim(body)
html = "<html>" & _
"<head><meta http-equiv=""Content-Type"" content=""text/html;charset=gb2312"">" & _
"<title>WinHttpRequest DEMO by Miaoqiyuan.cn - 實(shí)時(shí)獲取51.la統(tǒng)計(jì)信息</title>" & _
"<style type=""text/css"">" & _
".sitelist_n{height:35px;width:620px;background:#CCC;color:#000;line-height:35px;text-align:left;text-indent:10px;font-weight:800;}" & _
".sitelist_s{height:35px;width:620px;color:#666;line-height:35px;font-size:13px;text-align:left;text-indent:20px;}" & _
"</style>" & _
"</head>" & _
"<body><center><h1>WinHttpRequest DEMO by Miaoqiyuan.cn</h1><h2>實(shí)時(shí)獲取51.la統(tǒng)計(jì)信息</h2><hr />" & _
body & _
"<hr />Copyright: miaoqiyuan.cn 2011-" & year(now) & "" & _
"</center></body></html>"
response.write html
End Sub
select case request("act")
case "getcode"
Call getCode()
case "login"
Call Login()
case "dologin"
Call doLogin()
case else
Call Main()
end select
400 186 1886
