当前位置:编程学习 > asp >>

ASP版WinHttpRequest实时获取和抓取CNZZ统计信息

最近经常需要开发API,Microsoft.XMLHttp、MSXML2.XMLHTTP 等组件不能满足我的要求(主要是不能自定义header等信息),通过查资料发现了WinHttp.WinHttpRequest.5.1,但是关于winhttprequest的资料太少了。通过这几天摸索,勉强了解了WinHttpRequest使用方法

WinHttp.WinHttpRequest是一个非常实用的一个组件。作为站长,就会经常关注自己网站的流浪,今天以 免登陆获得cnzz统计信息

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
'=====================================================================
'=            WinHttpRequest演示实例 - 实时获取CNZZ统计信息          =
'=     Copyright (c) 2011 猫七(QQ:77068320) All rights reserverd.    =
'=              请尊重作者劳动成果,转载请保留代码的完整性           =
'=====================================================================
'= 作者:苗启源(博客:http://www.miaoqiyuan.cn)                       =
'= 发布:http://www.zzzyk.com/show/b3b7e9c67b090be0.htm
'= 最新:http://www.miaoqiyuan.cn/products/winhttprequest_demo.rar
'=====================================================================
'=  返回首页站点列表: winhttprequest_demo.asp                       =
'=  返回某站统计数据: winhttprequest_demo.asp?act=data&id=[站点ID]  =
'=====================================================================
'=  文件名:winhttprequest_demo.asp                                  =
'=  功  能:免登陆查看CNZZ 网站流量统计信息                          =
'=====================================================================
 
Dim HttpID,AppName,CNZZ_User,CNZZ_Password
HttpID        = 0
AppName       = "app_cnzz.com_demo"                   '应用程序名前缀,防止感染其他程序Application变量
CNZZ_User     = "kefu@myw3.cn"                        'CNZZ账号
CNZZ_Password = "CNZZTEST"                            'CNZZ密码
 
'函数名:OpenHttp
'功  能:创建Http请求,并返回服务器处理结果
'参  数:url          请求地址
'        PostData     请求数据包,如果是Get请求,请以SENDTYPE=GET开头
'        &strlocation 如果是服务器重定向网址,则返回重定向的地址
'特  点:自动保存/共享cookies,多次请求能保存登录状态
Function OpenHttp(byval url,byval PostData,byref strlocation)
    dim xmlhttp,xmlget,bgpos,endpos,sendtype
    HttpID = HttpID + 1
    if HttpID > 10 then
      response.write "1,连接次数过多"
      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","http://www.miaoqiyuan.cn/p/winhttp-winhttprequest-5-1_demo"
      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
 
'函数名:bin2str
'功  能:将2进制值转换为GB2312编码的字符串
'参  数:binstr       要转换的字符
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
 
'函数名:OpenRegExp
'功  能:创建正则对象,如果已经创建,则不重复创建
'参  数:&re       要创建的正则对象变量名称
function OpenRegExp(byref re)
  if not isobject(re) then
    set re = new RegExp
    re.ignorecase = true
    re.global     = true
  end if
end function
 
'函数名:OnlyTd
'功  能:去掉字体样式、换行符、空格
'参  数:html      要处理的Html代码
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
 
'函数名:NotLink
'功  能:去掉所有链接
'参  数:html      要处理的Html代码
function NotLink(byval Html)
  call OpenRegExp(re)
  Html = replace(Html,"</a>","")
  re.pattern = "<a([^<]*)>"
  Html = re.replace(Html,"")
  NotLink = Html
end function
 
'函数名:notImage
'功  能:去掉所有图片标签
'参  数:html      要处理的Html代码
function notImage(byval Html)
  call OpenRegExp(re)
  re.pattern = "<img([^<]*)>"
  Html = re.replace(Html,"")
  notImage = Html
end function
 
'函数名:midtrim
'功  能:去掉所有多余的空格
'参  数:html      要处理的Html代码
function midtrim(byval s)
  s = trim(s)
  s = replace(s," ","")
  for k = 0 to 50
    s = replace(s,"  "," ")
  next
  midtrim = s
end function
 
'函数名:Connect
'功  能:连接CNZZ并返回处理结果,如果没有登录,自动重新登录
'参  数:act      操作名称,主要简化代码量("http://new.cnzz.com/[ACT].php")
'        str      请求的数据
Function Connect(byval act,byval str)
  dim html
  html = OpenHttp("http://new.cnzz.com/" & act & ".php",str,strlocation)
  '如果未登录状态
  if instr(html,"已超时,请重新登录")>0 then
    '重新登陆
    login = OpenHttp("http://new.cnzz.com/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 "//账号认证失败"
    end if
    Connect = Connect(act,str)
  else
    Connect = html
  end if
End Function
 
'方法名:getData
'功  能:从CNZZ返回某站点数据
Sub getData()
  dim id,html
  id = request("id")
  if trim(id) = "" or not isnumeric(id) then
    response.write "//非法请求"
  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
 
'方法名:Main
'功  能:从CNZZ返回站点列表
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;"">如希望继续添加站点,请点击此处"
  set p = re.execute(html)
  if p.count > 0 then
    MainUI p(0).submatches(0)
  else
    response.write "对不起,CNZZ改版了。请访问:http://www.miaoqiyuan.cn/p/WinHttp-WinHttpRequest-5-1_DEMO 获取最新版本"
  end if
End Sub
 
'方法名:MainUI
'功  能:友好的显示处理结果
'参  数:body     输出正文内容
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统计信息</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统计信息</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

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,