Dim HttpID,AppName,CNZZ_User,CNZZ_Password
HttpID = 0
AppName = "app_#_demo"
CNZZ_User = "kefu@myw3.cn"
CNZZ_Password = "CNZZTEST"
Function OpenHttp(byval url,byval PostData,byref strlocation)
dim xmlhttp,xmlget,bgpos,endpos,sendtype
HttpID = HttpID + 1
if HttpID > 10 then
response.write "1,連接次數(shù)過多"
response.end
end if
strlocation = ""
sendtype = "SENDTYPE=GET"
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 then
url = url & "?" & replace(PostData,sendtype,"")
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
If InStr(.getResponseHeader("Set-Cookie"),"PHPSESSID") or InStr(.getResponseHeader("Set-Cookie"),"SPSESSION") then
Application(AppName & "APIOPcookie") = .getResponseHeader("Set-Cookie")
Application(AppName & "APIOPcookie") = left(Application(AppName & "APIOPcookie"),instr(1,Application(AppName & "APIOPcookie"),";")-1)
End if
End If
xmlget = bin2str(.responseBody)
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 OpenRegExp(byref re)
if not isobject(re) then
set re = new RegExp
re.ignorecase = true
re.global = true
end if
end function
function OnlyTd(byval Html)
Html = replace(Html,vbCrlf,"")
Html = replace(Html,"<br />","")
Html = replace(Html,"<br>","")
Html = replace(Html,"<br/>","")
Html = replace(Html,"</font>","")
Html = replace(Html," ","")
call OpenRegExp(re)
Html = re.replace(Html,"")
re.pattern = "<font([^<]*)>"
Html = re.replace(Html,"")
OnlyTd = Html
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 instr(html,"已超時，請重新登錄")>0 then
login = OpenHttp("http://new.#/user/login.php","username=" & CNZZ_User & "&password=" & CNZZ_Password & "&list=1&remuser=1",strlocation) if strlocation <> "/v1/main.php?s=site_list" then
response.write "http://賬號認證失敗"
end if
Connect = Connect(act,str)
else
Connect = html
end if
End Function
Sub getData()
dim id,html
id = request("id")
if trim(id) = "" or not isnumeric(id) then
response.write "http://非法請求"
else
id = cLng(id)
html = Connect("v1/data/site_list_data","SENDTYPE=GETsiteid=" & id)
html = "var data_arr = " & html & ";" & _
"var data_obj = document.getElementById('" & id & "_ty').getElementsByTagName('td');" & _
"data_obj[5].colSpan = 1;" & _
"var data_cel = data_obj[5].parentNode;" & _
"data_cel.insertCell();" & _
"data_cel.insertCell();" & _
"var outstr = '<table width=""100%"">';" & _
"data_obj[1].innerHTML = data_arr[0][0];" & _
"data_obj[2].innerHTML = data_arr[0][1];" & _
"data_obj[3].innerHTML = data_arr[0][2];" & _
"data_obj[5].innerHTML = data_arr[1][0];" & _
"data_obj[6].innerHTML = data_arr[1][1];" & _
"data_obj[7].innerHTML = data_arr[1][2];" & _
""
response.write html
end if
End Sub
Sub Main()
dim html
html = Connect("v1/main","SENDTYPE=GETs=site_list")
html = onlyTd(html)
html = notlink(html)
html = notImage(html)
Call OpenRegExp(re)
html = replace(html,"獲取代碼 | 設置 | 清零 | 刪除","-")
html = replace(html,"cellspacing=""0"" cellpadding=""0""","cellspacing=""1"" cellpadding=""1""")
re.pattern = "<span style=""float:right;padding-top:5px; padding-left:8px;""></span></div> </div>(.*)<tr> <td height=""40"" colspan=""5"" style=""text-align:center;"">如希望繼續(xù)添加站點，請點擊此處"
set p = re.execute(html)
if p.count > 0 then
MainUI p(0).submatches(0)
else
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 - 實時獲取CNZZ統(tǒng)計信息</title>" & _
"<script type=""text/javascript"">" & _
"function site_data(id){var s = document.createElement('script');s.src = '?act=data&id=' + id;document.getElementsByTagName('head')[0].appendChild(s);}" & _
"</script>" & _
"<style type=""text/css"">" & _
".list_box{width:900px;background:#666;};" & _
".list_box td,.list_box th{background:#FFF;line-height:25px;text-align:center;};" & _
".tr-bg4 td,.tr-bg4 th{background:#666;line-height:25px;};" & _
"</style>" & _
"</head>" & _
"<body><center><h1>WinHttpRequest DEMO by Miaoqiyuan.cn</h1><h2>實時獲取CNZZ統(tǒng)計信息</h2><hr />" & _
body & _
"</table><hr />Copyright: miaoqiyuan.cn 2011-" & year(now) & "" & _
"</center></body></html>"
response.write html
End Sub
select case request("act")
case "data"
Call getData()
case else
Call Main()
end select
400 186 1886
