当前位置:编程问答 > asp >

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

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