ASP版WinHttpRequest使用方法实时采集51.la统计信息


WinHttp.WinHttpRequest是一个非常实用的一个组件。作为站长，就会经常关注自己网站的流浪，今天以 免登陆获得 免登陆获得51.la统计信息 为例，一起了解下WinHttpRequest的使用方法。而51.la使用了验证码。






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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283


'======================================================================= 
'=            WinHttpRequest演示实例 - 实时获取51.la统计信息            = 
'=     Copyright (c) 2011 猫七(QQ:77068320) All rights reserverd.      = 
'=              请尊重作者劳动成果，转载请保留代码的完整性               = 
'======================================================================= 
'= 作者：苗启源(博客:http://www.miaoqiyuan.cn)                          = 
'= 发布：http://www.zzzyk.com/show/86a511b1f0173bce.htm 
'= 最新：http://www.miaoqiyuan.cn/products/winhttprequest_51lademo.rar 
'======================================================================= 
'=  返回首页站点列表： winhttprequest_demo_51la.asp                     = 
'=  读取并输出验证码： winhttprequest_demo_51la.asp?act=getcode         = 
'=  显示数据验证码框： winhttprequest_demo_51la.asp?act=login           = 
'=  验证验证码并登陆： winhttprequest_demo_51la.asp?act=dologin         = 
'======================================================================= 
'=  文件名：winhttprequest_demo_51la.asp                               = 
'=  功  能：免登陆查看51.la 网站流量统计信息                             = 
'======================================================================= 
 
Dim HttpID,AppName,CNZZ_User,CNZZ_Password 
HttpID        = 0 
AppName       = "app_51.la_demo"                      '应用程序名前缀，防止感染其他程序Application变量 
La51_User     = "myw3demo"                            '51.la账号 
La51_Password = "la51test"                            '51.la密码 
 
'函数名：OpenHttp 
'功  能：创建Http请求，并返回服务器处理结果 
'参  数：url          请求地址 
'        PostData     请求数据包，如果是Get请求，请以SENDTYPE=GET开头 
'        &strlocation 如果是服务器重定向网址，则返回重定向的地址 
'特  点：自动保存/共享cookies，多次请求能保存登录状态，新增二进制获取 
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,连接次数过多"
      response.end 
    end if 
    strlocation = ""
    '与CNZZ的实例对比，增加了获取验证码的功能 
    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","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 
      '阿江的Cookies比较易做图，有3个Set-Cookie，因为这个问题，浪费了好几个小时 
      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
 
'函数名：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
 
'函数名：getAJiangCookies 
'功  能：从http头中返回多个cookies值 
'参  数：strHeader    HTTP头 
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
 
'函数名：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
 
'函数名：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 
'功  能：连接51.la并返回处理结果，如果没有登录，自动重新登录 
'参  数：act      操作名称，主要简化代码量("http://www.51.la/[ACT].asp") 
'        str      请求的数据 
Function Connect(byval act,byval str) 
  dim html 
  html = OpenHttp("http://www.51.la/" & act & ".asp",str,strlocation) 
  '如果未登录状态，则进入登录页面 
  if strlocation = "../login.asp" then 
    response.redirect "?act=login"
  elseif strlocation <> "" then 
    Connect = strlocation 
  else 
    Connect = html 
  end if 
End Function
 
'方法名：getCode 
'功  能：获取验证码 
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
 
'方法名：Main 
'功  能：从51.la返回站点列表 
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]*点击“查看统计报表”可查看实时数据。"
  ra.pattern = "\( 合计当前显示的[\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 
    response.write "对不起，51.la改版了。请访问：http://www.miaoqiyuan.cn/p/WinHttp-WinHttpRequest-5-1_DEMO 获取最新版本"
  else 
    html = re.replace(html,"") 
    html = ra.replace(html,"") 
    html = rm.replace(html,"") 
    html = "<div>" & html & "</div>"
    Call MainUI(html) 
  end if 
End Sub
 
'方法名：Login 
'功  能：获取登录界面 
Sub Login() 
  dim html 
  html = "<form action=""?act=dologin"" method=""POST"">" & _ 
         "第一次访问的时候，需要输入验证码：" & _ 
         "<input name=""vcode"" size=""4"" />" & _ 
         " <img src=""?act=getcode&timer=" & timer() & """ /> " & _ 
         "<input type=""submit"" value=""提交""/>" & _ 
         "</form>"
  Call MainUI(html) 
End Sub
 
'方法名：doLogin 
'功  能：登录51.la 
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,"验证码不正确") then 
    Call MainUI("<a href=""?act=login"">验证码不正确，请重新登录</a>") 
  else 
    Call MainUI("<a href=""?act=login"">账号或密码错误，请修改配置并重新登录</a>") 
  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 - 实时获取51.la统计信息</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>实时获取51.la统计信息</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