楼主
xmyjk |
Q:附件里有考生的考号和姓名，后面跟着各科科目。要求使用VBA自动提交姓名和考号，并把获取的成绩自动填写在表格里面，
查询地址 http://www.hd.qdedu.net/index.aspx?pkId=4282首页有个2012中考查询，点开就看到了。
A:用抓包软件测试的时候，
发现，居然POST里面没有数据，但是，明明我们输入和考号和姓名，那么参数传递怎么传递的呢？
查询COOKIE，有CONDITION这一个字段，猜测，应该是参数在这里面。（网页码源也能看出来，只是要看好多脚本）
CONDITION里面的值是通过FIDDLER里面的转码工具以后转码，就豁然开朗了。如图：
 - Option Explicit
- Sub test()
- Dim xmlhttp, Cookie$, p&, tmp, I&
- For p = 2 To [a65536].End(3).Row '循环历遍工作表的考生数据
- '设置COOKIE字段，查询参数隐藏在COOKIE中
- Cookie = "result=HTFxsWuUdjAjHeUmWGEY0sVvaz5FRr6WUNVp6KITZdfGk3pqZT0k5ADA%2FxiKm2fQh8Q8RJWDlhEZHV3QYMbIRGCHExX%2FzFeRIfYaXEnOZY3oMwBTYWXrBicJK8skRNMwCmYN79gdLpY%2BBB7n1D0R%2BqqQSpIsedAgUt2uikg59A1GplHEDY1fHDI1L2Qz%2FH54; " & _
- "condition=%E4%B8%AD%E8%80%83%E8%80%83%E5%8F%B7%20%3D%20'" & Cells(p, 1).Value & "'%20AND%20%E4%B8%AD%E8%80%83%E5%A7%93%E5%90%8D%20%3D%20'" & UrlEncode(Cells(p, 2).Value) & "'%20; menuname=%E6%88%90%E7%BB%A9%E6%9F%A5%E8%AF%A2; layouttemplateid=548; " & _
- "resultformat=zCeOnGpbMkF899qfVZ2tHmEE5mQVApOcmv8YmUVIRcZk0Y7H%2FbeaaWDfO0Ig%2BvEK6CxzR%2BH8j7Hldbr%2B1O01AYu%2FtYF1U%2FE6g0jOy1D5DxQ26tcdOMAF7f%2FSHEqyKIO6**lI9SVnRH7gRF1m52liPWVDF3%2FnsO1jlZ6fTHhkw1pa08TNrZqaqEVDINTSKo3yUjf8jRLJ7opBm94rxbdGqZ9OnT2nAb04Vax%2FCj%2BIWO38VisR53P4x%2FQa08w6vbNMaLBCfC0ZkB5T0SIcGb7byPdILFJo2plvPQX%2FReTnmmnoZYbbz8676gXPkpARduGUU4tLdOS9kBq1KvYuyDzTWVZBUWPaSZjxcxHbUctQn2o0BwZS%2Fg9yLk9cgz33zOBgyoKiQXNq%2BKi0xgQpsAGVeCKZSjH%2FxcdiLn4FmKuWjnasaMSCOjBR9uLLjKGeG202uHATwxvmmks%2BVqVUY%2FohPgkCmaqFzWzqpImWOkXjaWxAWOlrpjemSjfmGgosXJHtgDH4VyJN03xlrvPnL%2FZ4wU%2FNOsSwHBkmpwiSXLGoVw%3D;"
- Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1") '建立WINHTTP对象
- With xmlhttp
- .Option(6) = 1 '允许重定向
- .Open "GET", "http://www.hd.qdedu.net/newsinfo.aspx?template=infosearch", False '发包
- .setRequestHeader "Cookie", Cookie '设置COOKIE
- .SEND
- tmp = Filter(Split(.responsetext, "</td>"), "#fff;font-size:12;"">") '切取结果数据至数组
- End With
- For I = 0 To UBound(tmp) '以下均为结果数据处理过程
- tmp(I) = Replace(Replace(tmp(I), "</font>", ""), " ", "")
- tmp(I) = Split(tmp(I), ">")(UBound(Split(tmp(I), ">")))
- Next
- Cells(p, 3).Resize(1, UBound(tmp) + 1) = tmp
- Next
- End Sub
- Public Function UrlEncode(ByRef szString As String) As String '由于URL或者发包不支持中文和符号，需要转码
- Dim szChar As String
- Dim szTemp As String
- Dim szCode As String
- Dim szHex As String
- Dim szBin As String
- Dim iCount1 As Integer
- Dim iCount2 As Integer
- Dim iStrLen1 As Integer
- Dim iStrLen2 As Integer
- Dim lResult As Long
- Dim lAscVal As Long
- szString = Trim$(szString)
- iStrLen1 = Len(szString)
- For iCount1 = 1 To iStrLen1
- szChar = Mid$(szString, iCount1, 1)
- lAscVal = AscW(szChar)
- If lAscVal >= &H0 And lAscVal <= &HFF Then
- If (lAscVal >= &H30 And lAscVal <= &H39) Or _
- (lAscVal >= &H41 And lAscVal <= &H5A) Or _
- (lAscVal >= &H61 And lAscVal <= &H7A) Then
- szCode = szCode & szChar
- Else
- szCode = szCode & "%" & Hex(AscW(szChar))
- End If
- Else
- szHex = Hex(AscW(szChar))
- iStrLen2 = Len(szHex)
- For iCount2 = 1 To iStrLen2
- szChar = Mid$(szHex, iCount2, 1)
- Select Case szChar
- Case Is = "0"
- szBin = szBin & "0000"
- Case Is = "1"
- szBin = szBin & "0001"
- Case Is = "2"
- szBin = szBin & "0010"
- Case Is = "3"
- szBin = szBin & "0011"
- Case Is = "4"
- szBin = szBin & "0100"
- Case Is = "5"
- szBin = szBin & "0101"
- Case Is = "6"
- szBin = szBin & "0110"
- Case Is = "7"
- szBin = szBin & "0111"
- Case Is = "8"
- szBin = szBin & "1000"
- Case Is = "9"
- szBin = szBin & "1001"
- Case Is = "A"
- szBin = szBin & "1010"
- Case Is = "B"
- szBin = szBin & "1011"
- Case Is = "C"
- szBin = szBin & "1100"
- Case Is = "D"
- szBin = szBin & "1101"
- Case Is = "E"
- szBin = szBin & "1110"
- Case Is = "F"
- szBin = szBin & "1111"
- Case Else
- End Select
- Next iCount2
- szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)
- For iCount2 = 1 To 24
- If Mid$(szTemp, iCount2, 1) = "1" Then
- lResult = lResult + 1 * 2 ^ (24 - iCount2)
- Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)
- End If
- Next iCount2
- szTemp = Hex(lResult)
- szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)
- End If
- szBin = vbNullString
- lResult = 0
- Next iCount1
- UrlEncode = szCode
- End Function
 中考数据.rar
|
