|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
我收集的资料，供你参考
近期写了一段程序：从网上下载数据，写入数据库，查询、分析、打印。找了很多的资料，现作一回顾总结，本篇主要写网页数据下载与控制。（以下均为本人的一些心得，写的不对的，请各位师傅指正。希望本文能对和我一样菜的朋友有一些帮助。）
一、概述及感谢
二、Maxthon的使用
三、网页关键字（录入、按钮、数据）解读
四、POST、GET与NAME、VALUE
五、使用WebBrowser
六、使用IE
七、查询结果是新弹出窗口的控制
八、使用POST方法
九、使用EXCEL获取网页数据
十、例：利用webbrowser获得网页数据
附件一、XmlHttp对象用法示例与说明
一、概述及感谢
需要用到网页控制的方面，大致概括一下为：
1、程序中需要嵌入一个网页，例如：天气预报。
2、需要从网上下载数据，写入到本地数据库中。
特别需要感谢Winland对我的指导。
二、Maxthon的使用
无论哪方面的应用，首要的是找到网址（也许是废话）。
以Winland的天气预报为例，假如我的程序需要这样一个东西，我该如何下爪：
1、打开http://www.17u.cn
2、点击“天气预报”，打开：http://www.17u.cn/tianqi
3、查一个城市试试，此时结果找到了，但网址没变。
4、点击Maxthon的viewpage。
5、在“框架”中，发现一个“内嵌框架”，点击打开。发现原来天气预报的网址为：
http://www.17u.cn/WeatherInfoIfm.aspx?CityName=%e5%ae%9c%e6%98%8c
6、下一步，在我们自己的程序中就可以使用这个网址，直接来查询了。
综上所述，通过Maxthon，我们可以很方便地找到我们所需要的真正的网址。
在viewpage中还有一个“表单”，里面很清楚地显示了Name,method,以及Action。我理解这个Action就是“结果网页”的网址的后半部分（不知对不对？）。
（在网页的表单里面Action是目标地址，就是处理这些递交内容的服务器端脚本。 如果Action为空的话，就是当前文件。）
三、网页关键字（录入、按钮、数据）解读
<% 和 %> ASP脚本片断的开始和结束。在<%和%>标签之间的脚本代码，在主页传递给用户浏览器之前 会在服务器上执行。
<HTML> 和 </HTML> <HTML>标示网页的开头，</HTML>标示网页的结束。
<BODY> 和 </BODY> 网页上的文本应该放置在这些标示之间
<TABLE> 和 </TABLE> 表格的开始和结束
<TABLE Border = “1”> 表格边框参数明确表格边框的宽度
<TH> 和 </TH> 放置表格标题于这些标示之间
<TR> 和 </TR> 标示<TR>在表格里开始一新行。表格中每行以</TR>标示结束。
<TD> 和 </TD> 使用这些标示来明确表格单元格。每个单元格以<TD>标示开始，以</TD>标示结束。表格单元格可以包含任何内容，包括另一个表格。
我们需要重点关注的就是：<TABLE> 和 </TABLE>，<TR> 和 </TR>以及<TD> 和 </TD>。
文本框：<INPUT TYPE="text" NAME="Amount" VALUE="1" SIZE=10>，有的省略了TYPE，VALUE及SIZE，但应该是有关键字INPUT及NAME。
选择框：<SELECT NAME="From" SIZE=5 onChange="CheckMore()">
<OPTION VALUE="EUR" SELECTED>EUR Euro</OPTION> ‘当前值
<OPTION VALUE="USD">USD United States Dollars</OPTION>
<OPTION VALUE="CAD">CAD Canada Dollars</OPTION>
…
</SELECT><BR>
单选钮：<INPUT type=radio CHECKED value=1 name=order>升序 ‘当前选择
<INPUT type=radio value=2 name=order>降序
按健：<INPUT language=javascript onclick="return onclick1()" type=submit value=查询 name=fetchevent>
（winland注解：这个地方建议写的详细一点，先介绍一下简单的HTML文档格式，再说说Document Object Model，这个对下面的内容更有帮助。）（查了一下关于DOM的内容，大致看了一下，好像很复杂，也没有一个介绍的比较系统的，所以，暂时写不出来。）
四、POST、GET与NAME、VALUE
为了从网页获取数据，需要明确参数。要在网络查询里，向网络服务器发送参数的话，那么需要在核实某个具体网络服务器使用哪种方法后，使用POST或者GET方法。
打开源码，查找“POST”，如果给网络服务器发送参数使用的是POST方法，那么文本POST就应该出现。如果网络服务器使用GET方法接收参数的话，那么可以在浏览器地址栏里看到该参数名称和值。例如：
http://www.nycenet.edu/dist_sch/ ... /asp?boro=Manhattan &flag= schoolInfo2
（第一个参数前面带有一个问号，参数之间使用&符号分割开来，参数的先后排列顺序不重要）
查找“Name”，在单词name之后，可以看到括号里有一些文本， 这些文本就是第一个参数的名称。在单词“value=”后面，是参数的当前值。例如：
<INPUT TYPE="text" NAME="Amount" VALUE="1" SIZE=10><BR>
在上面的HTML语句中，单词“Amount”是参数名称，“1”是该参数的当前值。参数值也可以是HTML<option>标签中的 选项之一。例如：
<SELECT NAME="From" SIZE=5 onChange="CheckMore()">
<OPTION VALUE="EUR" SELECTED>EUR Euro</OPTION> ‘当前值
<OPTION VALUE="USD">USD United States Dollars</OPTION>
<OPTION VALUE="CAD">CAD Canada Dollars</OPTION>
<OPTION VALUE="GBP">GBP United Kingdom Pounds</OPTION>
<OPTION VALUE="DEM">DEM Germany Deutsche Marks</OPTION>
…
</SELECT><BR>
Post与Get的区别：
1、Get是用来从服务器上获得数据，而Post是用来向服务器上传递数据。
2、Get将表单中数据的按照variable=value的形式，添加到action所指向的URL后面，并且两者使用“?”连接，而各个变量之间使用“&”连接；Post是将表单中的数据放在form的数据体中，按照变量和值相对应的方式，传递到action所指向URL。
3、Get是不安全的，因为在传输过程，数据被放在请求的URL中，而如今现有的很多服务器、代理服务器或者用户代理都会将请求URL记录到日志文件中，然后放在某个地方，这样就可能会有一些隐私的信息被第三方看到。另外，用户也可以在浏览器上直接看到提交的数据，一些系统内部消息将会一同显示在用户面前。Post的所有操作对用户来说都是不可见的。
4、Get传输的数据量小，这主要是因为受URL长度限制，只能传递大约1024字节；而Post可以传输大量的数据，可以达到2M，所以在上传文件只能使用Post。
5、Get限制Form表单的数据集的值必须为ASCII字符；而Post支持整个ISO10646字符集。
6、Get是Form的默认方法。
五、使用WebBrowser
使用WebBrowser需要添加“Microsoft Web 浏览器”（VBA）或“Microsoft internet controls”（VB）。
1、WebBrowser的简要使用方法：
‘打开前
Urlstr="http://www.17u.cn/WeatherInfoIfm.aspx?CityName=%e5%ae%9c%e6%98%8c"
F_tqyb.WebBrowser1.Navigate Urlstr
F_tqyb.Show ‘这句话屏蔽时，WebBrowser同样打开网页，不过不显示在桌面上
Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
If WebBrowser1.ReadyState <> READYSTATE_COMPLETE Then Exit Sub ‘页面调用是否完毕
……
End Sub
2、我们想要的网页内容：
一般说来，我们想要的网页内容，就在WebBrowser1.document.body.innerhtml和WebBrowser1.document.body.innertext中，通过替换、分析，得到我们想要的数据。
Innerhtml中的内容就是网页源码。
innertext中的内容则是网页上所显示的内容。（这个内容就是我们把网页另存为文本时的内容）
个人认为使用Innerhtml要方便一些。
3、在程序中使用WebBrowser显示网页
⑴、如果你所需要的网页网址中带有？，且取值规则非常清楚，则很方便，直接将参数及值写到网址中就好，如上例所示（显示宜昌的天气），只需注意：第一个参数前面带有一个问号，参数之间使用&符号分割开来，参数的先后排列顺序不重要。
如果值中带有非英文和数字，则需进行转换。（套用Winland的程序）
例：City= Escape(“宜昌”)
Public Function Escape(ByVal strText As String) As String
Dim JS As ScriptControl
Set JS = New MSScriptControl.ScriptControl
JS.Language = "JavaScript"
Escape = JS.Eval("encodeURI('" & Replace(strText, "'", "\'") & "');")
End Function
⑵、如果你所需要的网页网址中带有？，但取值规则不清楚，比如用一长串数值代替，则需要从上一级开始查起，我们估且称之为“查询网页”和“结果网页”。
通过分析“查询网页”使用程序自动输入、选择、点击，或用户使用时输入、选择、点击，打开“结果网页”。
但此时就存在一个问题：“结果网页”是在新窗口中打开的，并没有显示在WebBrowser1中！这时候，我们从下面的几种方法中找到一种适合于自己的：（具体见后）
①、“遍历已打开的IE窗口”，找到“结果网页”，读网址、关闭网页，使用EXCEL的“获取外部数据”将网页内容读到EXCEL中。
②、“遍历已打开的IE窗口”，找到“结果网页”的hwnd（句柄），置为当前，然后模拟鼠标点击一下，再sendkey：全选、复制、关闭网页，最后在EXCEL中粘贴。
③、“遍历已打开的IE窗口”，找到“结果网页”，恢复对IE的控制，读innerhtml，分析innerhtml。
④、强制新窗口也在WebBrowser1中显示，不另开IE或Maxthon，读innerhtml，分析innerhtml。
⑤、使用POST方法（winland提供）。
⑥、使用EXCEL的POST方法。
⑶、如果你所需要的网页网址中没有？，无论你的查询条件是什么，“结果网页”的网址都不变，此时，如果直接在IE中输入该地址，则什么也得不到。对于这类网页也只能从上一级开始查起，同上。
（我刚完成的这个程序就属于这类，使用winland提供的POST方法都不行，最后使用EXCEL的POST方法完成）
六、使用IE
1、如果不想使用WebBrowser，而想使用Internet Explorer，或者“结果网页”是新窗口而“被迫”使用，控制起来也还比较方便。
Dim IEPL As Object
Set IEPL = CreateObject("InternetExplorer.Application")
IEPL.Visible = False ‘隐藏
‘打开网页
URLstr=”http://www.XXX.XXX”
IEPL.Navigate URLstr
‘与webbrowser一样，当页面调用完毕时，发生DocumentComplete事件。
‘读Innerhtml
……
IEPL.Quit ‘关闭
或：
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
遍历已打开的IE窗口，通过窗口标题找到刚才打开的IE（或“结果网页”新窗口），恢复对IE的控制。
‘遍历已打开的IE窗口
Dim dWinFolder As New ShellWindows
Dim objIE As Object
Dim Czpmxurl As String, Czpmxname As String
For Each objIE In dWinFolder
Czpmxname = objIE.LocationName ‘标题
If InStr(Czpmxname, "查询结果") Then
Zdurl = True
End If
Next
If Zdurl then ‘找到了
objIE.application.Visible = False ‘隐藏
Czpmxurl = objIE.LocationURL ‘网址
‘读Innerhtml
……
end if
objIE.application.Quit ‘关闭
2、如果“结果网页”新窗口不是IE，而是Maxthon，则要麻烦一些，上面提到的隐藏和关闭方法对Maxthon分别无效和出错，其它控制方法倒是一样。此时要关闭Maxthon，则要使用sendkey Alt+F4的方法了。
当然，也可以通过修改注册表，将IE设置为默认。
七、查询结果是新弹出窗口的控制
当查询结果是新弹出窗口，前面已谈到IE控制，下面再谈两种方法：
1、例：通过窗口标题，找到“结果网页”的hwnd（句柄），置为当前，然后模拟鼠标点击一下，再sendkey：全选、复制、关闭网页，最后在EXCEL中粘贴。
‘定义API函数
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Public Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
‘定义
Dim Czpmxhwnd As Long
Czpmxhwnd = FindWindow(vbNullString, "http://www.XX.XX - 查询结果 - Microsoft Internet Explorer") ‘根据窗口标题查找，找到后返回句柄
If Czpmxhwnd = 0 Then Czpmxhwnd = FindWindow(vbNullString, "查询结果 - Microsoft Internet Explorer")
If Czpmxhwnd = 0 Then
MsgBox "未找到", vbOKOnly, "提示"
Exit Sub
End If
aa = SetForegroundWindow(Czpmxhwnd) ‘将网页调到前台
Sleep 100
mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0&, 0&, 0, 0 ‘模拟鼠标点击，设置焦点
Sleep 100
SendKeys "^a", True ‘Ctrl+A全选
Sleep 100
SendKeys "^c", True ‘Ctrl+C复制
Sleep 100
SendKeys "%{F4}", True ‘Alt+F4关闭
‘打开EXCEL，粘贴
……
2、强制新窗口也在WebBrowser1中显示，不另开IE或Maxthon
使用该方法，不管是通过程序“自动点击”“提交”按钮，还是用户点击“提交”按钮，都强制新窗口也在WebBrowser1中显示，不另开IE或Maxthon。
新建窗口from1，窗口中放置一个WebBrowser1。
Private Sub Form_Load()
Dim Strurl as string
Strurl="……" ‘网址
WebBrowser1.Navigate strurl
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
‘当有新弹出窗口时触发
Dim NewWindow As Form1
Set NewWindow = New Form1
NewWindow.Show
Set ppDisp = NewWindow.WebBrowser1.Object
‘VBA中以上命令出错，需改为：
‘Set ppDisp = NewWindow.WebBrowser1
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
‘网页”下载完毕”时触发
Dim I As Single, J As Single
If WebBrowser1.ReadyState <> READYSTATE_COMPLETE Then Exit Sub ‘网页全部打开
‘根据窗口标题或其它属性判断完成的是“查询网页”还是“结果网页”
‘根据不同的要求，写相应的命令
……
End Sub
八、使用POST方法（winland提供）
使用这个方法，首先得根据“查询网页”中的内容，编写要提交的查询字串。当然，如果有非英文和数字，还必须利用上面的Escape函数进行转换。
strQuery="year_start=%202007&month_start=%205&date_start=%2012&" & _
"hour_start=%200" & _
"&year_end=%202007&month_end=%205&date_end=%2013&hour_end=%200" & _
"&substation%5B%5D=00&R1=sortall&order=1&desckey="
‘以上这句话的意思是起始年月日时为：2007-5-12 0时（%20为空格），终止时间：2007-5-13 0时，单位为00（%5B%5D为[]），全部内容，升序，关键字无。
‘这里面没有“提交”按钮的内容
Call QueryStr(strQuery)
Public Sub QueryStr(strQuery As String)
Dim httpRequest As MSXML2.XMLHTTP30
Dim txtContent As String
Dim strBuffer As String
Dim lngBufferSize As Long
Dim lngResult As Long
Dim arrByte() As Byte
Dim lSize As Long
Dim l As Long
Set httpRequest = New MSXML2.XMLHTTP30
httpRequest.Open "POST", "http://10.228.98.9/eventresult.php", False
httpRequest.setRequestHeader "Content-Type", "text/html"
httpRequest.send strQuery
If httpRequest.Status = 200 Then
ReDim arrByte(UBound(httpRequest.responseBody)) As Byte
For l = 0 To UBound(httpRequest.responseBody)
arrByte(l) = httpRequest.responseBody(l)
Next l
lngBufferSize = (UBound(arrByte) + 1) * 2
strBuffer = String$(lngBufferSize, vbNullChar)
lngResult = MultiByteToWideChar(936, 0, arrByte(0), lngBufferSize / 2, StrPtr(strBuffer), lngBufferSize)
txtContent = Left(strBuffer, lngResult)
MsgBox txtContent
Else
reportErr (httpRequest.Status)
End If
httpRequest.abort
Set httpRequest = Nothing
End Sub
Sub reportErr(lStatus As Integer)
Select Case lStatus
Case 400
MsgBox "Bad Request", vbCritical, "连接错误"
Case 401
MsgBox "Unauthorized", vbCritical, "连接错误"
Case 402
MsgBox "Payment Required", vbCritical, "连接错误"
Case 403
MsgBox "Forbidden", vbCritical, "连接错误"
Case 404
MsgBox "Not Found", vbCritical, "连接错误"
Case 407
MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
Case 408
MsgBox "Request Timeout", vbCritical, "连接错误"
Case 503
MsgBox "Service Unavailable", vbCritical, "连接错误"
Case Else
MsgBox "Can not reach by other reason", vbCritical, "连接错误"
End Select
End Sub |
|
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-10-18 10:52
楼主
发表于 2009-10-19 10:18
