如何用 Access 下载 DVBBS 论坛上所有的帖子？ Www@Chinaz@com
如何用 ACCESS 编写灌水程序？
中.国.站.长.站
方法一：
站.长.站
答案非常简单—— DHTML 编程。 中.国站长站
有人可能问了，ACCESS 使用的是 VBA ，而 DHTML 中使用的是 VBS 怎么可能通用哪？其实 VBS / VBA 都是 VB 的子集。在 Access 中只要引用
Chinaz~com
Microsoft Internet Controls 中国站长_站,为中文网站提供动力
Microsoft HTML Object Library
中国站长.站
即可，然后在窗体上加入 “Microsoft Web 浏览器”控件 Www@Chinaz@com
好了，下面就以我写的一个读取某 IP 物理地域查询网站页面的数据库为例说明 DHTML / “Microsoft Web 浏览器”控件在 ACCESS 的应用吧。
Chinaz_com
“Microsoft Web 浏览器”控件的作用是什么哪？主要就是为了获得 DOCUMENT 对象的，DHTML 的操作都是以 DOCUMENT 对象为运行基础的。
中.国站长站
要完成读取网页的功能我们必须了解 DHTML 的几个简单的对象以及属性 中国.站长站
1、DOCUMENT 对象：代表这整个 HTML 文档 中国站长_站,为中文网站提供动力
2、BODY 对象：是 DOCUMENT 对象的子对象，里面存储着所有显示给用户看的 HTML 代码
中.国.站长站
3、innerText 属性：页面中显示给客户看的文本，注意：不是 HTML 代码呦
Chinaz~com
4、innerHTML属性：构成页面的 HTML 代码 中.国.站长站
5、对象.all.length属性：页面中所有 element 的个数。（all 用于表示所有对象）
[中国站长站]
ok ，接下来就让我们一边写代码，一边分析吧： 站.长.站
以下为引用的内容：
Option Compare Database
Dim blnSwitch As Boolean
Private Sub Command1_Click() '用于启动浏览功能
Me.WebBrowser3.Navigate ("http://ip.loveroot.com/index.php?job=search")
End Sub [中国站长站]
Private Sub Command11_Click() '将需要搜索的IP 写入全局变量
splitIP Text1.Value
End Sub
Function splitIP(strip) '将需要搜索的IP 写入全局变量
Dim a() As String
strip = strip & "."
a = Split(strip, ".") Chinaz.com
Dim i As Long
For i = 0 To UBound(a)
If a(i) = "" Then a(i) = "0"
lngSearchIP(4 - i) = CLng(a(i))
Next i 中.国.站.长.站
End Function Www@Chinaz@com
Sub WriteLog(ip1 As String) '读取结果
Dim dc As MSHTML.HTMLDocument
Dim Bd As MSHTML.HTMLBody
Dim El As MSHTML.HTMLElementCollection
Dim strip As String
Dim strAdd As String
Dim strSql
Dim i As Long
Set dc = WebBrowser3.Document 站.长.站
Set Bd = dc.body
Dim lngStart As Long
'循环 DOCUMENT 中所有的元素获取需要的字符
For i = 0 To dc.all.length - 1
'由于该服务器重写界面，我改了一下分析代码
'If dc.all(i).tagName = "p" And Left(dc.all(i).innerText, 4) = "查询结果" Then
If dc.all(i).tagName = "p" And Left(dc.all(i).innerText, 8) = "官方数据查询结果" Then
'由于该服务器重写界面，我改了一下分析代码
'strAdd = Mid(dc.all(i).innerText, InStr(1, dc.all(i).innerText, "(") + 2, InStr(1, dc.all(i).innerText, ")") - InStr(1, dc.all(i).innerText, "(") - 3)
Www~Chinaz~com
'strip = Mid(dc.all(i).innerText, InStr(1, dc.all(i).innerText, "查询结果：") + 6, InStr(1, dc.all(i).innerText, "(") - InStr(1, dc.all(i).innerText, "查询结果：") - 7)
strAdd = Right(dc.all(i).innerText, Len(dc.all(i).innerText) - InStr(dc.all(i).innerText, " - ") - 3)
strip = strNowIP
LabelSIP.Caption = strip & strAdd
'ok 终于得到需要的数据了，用 SQL 语句直接写入数据库吧
strSql = "update ipaddress set [ip1]='" & strip & "',[add]='" & strAdd & "' where mark='last'"
CurrentProject.Connection.Execute strSql Chinaz.com
strSql = "insert into ipaddress([ip1],[add],[mark],[enip]) values('" & strip & "','" & strAdd & "','no'," & CStr(enaddr(strip)) & ")"
CurrentProject.Connection.Execute strSql
Exit For
End If
Next i [中国站长站]
Dim strNewIP As String
strNewIP = refreshIP
On Error Resume Next 中国.站长站
中国.站.长站
'利用 DHTML 的 innerHTML 来更改网页的源代码，建立一个简单的 FORM ，然后提交给服务器，继续查询下面的 IP
以下为引用的内容：
Bd.innerHTML = "<form method='POST' action='index.php?job=search' target='_parent'><input type='text' name='search_ip' ><input type='submit' value='查询' name='B1'></form>"
'在 INPUT TEXT search_ip 中填入 IP。
dc.all.Item("search_ip").Value = strNewIP
'用 DHTML 提交 FORM 到服务器
dc.all.Item("b1").Click
End Sub
Private Sub Form_Open(Cancel As Integer)
中国站.长.站
Text1.Value = Nz(DLookup("ip1", "ipaddress", "[mark]='last" & Me.Caption & "'"), "1.0.0.0") Www.Chinaz.com
End Sub
Www.Chinaz.com
Private Sub WebBrowser3_DownloadComplete() Chinaz^com
中.国.站长站
'该事件在页面成功下载到本地时运行，这时候 DOCUMENT 对象
Www~Chinaz~com
'已经完全被客户端浏览器读取了，我们只要获取 Body 对象中的 innerHTML 即可
Chinaz@com
以下为引用的内容：
If Len(strNowIP) = 0 Then
splitIP Text1.Value
End If
If check1.Value = True Then
Call WriteLog("61.12.15.117")
End If
End Sub
中国站长_站,为中文网站提供动力
Function refreshIP() As String '搜索完一个IP以后再搜索下面一个
Dim i As Long
lngSearchIP(2) = lngSearchIP(2) + 1
For i = 2 To 4
If lngSearchIP(i) >= 256 Then
lngSearchIP(i) = 0
lngSearchIP(i + 1) = lngSearchIP(i + 1) + 1
End If
Next i
refreshIP = Format(lngSearchIP(4), "0") & "." & Format(lngSearchIP(3), "0") & "." & Format(lngSearchIP(2), "0") & "." & Format(lngSearchIP(1), "0")
strNowIP = refreshIP
Debug.Print refreshIP
End Function [中国站长站]
中国.站长站
以下代码请新建一个模块后 COPY 进去
Www.Chinaz.com
以下为引用的内容：
Option Compare Database
Public lngSearchIP(4) As Long
Public strNowIP As String
Public strOKAddress As String
Public strOKIP As String
Public blnStop As Boolean
Function writeOKIP()
Dim rs As New ADODB.Recordset
Dim strSql As String
中国.站.长站
strSql = "select * from ipaddress order by enip"
rs.Open strSql, CurrentProject.Connection, 1, 1
Dim strAdd1 As String
Dim strIP1 As String
Dim lngENIP1 As Long
Dim strState As String
strState = "start"
Dim i As Long
Dim iA As Long
iA = rs.RecordCount
Do Until rs.EOF
If blnStop = True Then Exit Function
If strAdd1 <> rs("add") Then
strSql = "update ipaddress_ok set ip2='" & strIP1 & " ',enip2=" & Str(lngENIP1) & ",mark=' where mark='setting'"
中国站.长站
CurrentProject.Connection.Execute strSql
DoEvents
strSql = "insert into ipaddress_ok (ip1,enip1,[mark],[add]) values('" & rs("ip1") & "'," & Str(rs("enip")) & ",'setting','" & rs("add") & "')"
CurrentProject.Connection.Execute strSql
DoEvents
End If
strAdd1 = rs("add")
strIP1 = rs("ip1")
lngENIP1 = rs("enip") 站.长.站
i = i + 1 中国站.长.站
Form_控制.Label4.Caption = Str(Int(i / iA * 10000) / 100) & "%"
rs.MoveNext
Loop
rs.Close
strSql = "update ipaddress_ok set ip2=mid(ip2,1,len(ip2)-2) & '255'"
CurrentProject.Connection.Execute strSql
strSql = "update ipaddress_ok set enip1=enaddr(ip1)"
CurrentProject.Connection.Execute strSql
strSql = "update ipaddress_ok set enip2=enaddr(ip2)"
CurrentProject.Connection.Execute strSql
End Function
Function enaddr(Sip As String) As Double Chinaz@com
站.长站
'用代理无法连接的问题还要解决 站.长.站
'将字符的 IP 编码为长整的 IP
中国站长_站,为中文网站提供动力
以下为引用的内容：
On Error Resume Next
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String
Sip = CStr(Sip)
str1 = Left(Sip, CInt(InStr(Sip, ".") - 1))
Sip = Mid(Sip, CInt(InStr(Sip, ".")) + 1)
str2 = Left(Sip, CInt(InStr(Sip, ".")) - 1)
Sip = Mid(Sip, CInt(InStr(Sip, ".")) + 1)
str3 = Left(Sip, CInt(InStr(Sip, ".")) - 1) Www@Chinaz@com
str4 = Mid(Sip, CInt(InStr(Sip, ".")) + 1)
enaddr = CLng(str1) * 256 * 256 * 256 + CLng(str2) * 256 * 256 + CLng(str3) * 256 + CLng(str4) - 1
End Function
中国站.长站
Function deaddr(Sip)
中国.站长站
中国.站.长站
'将编码为长整的 IP 重现转换为字符型的 IP
Chinaz^com
以下为引用的内容：
Dim s1, s21, s2, s31, s3, s4
Sip = Sip + 1
s1 = Int(Sip / 256 / 256 / 256) Chinaz.com
s21 = s1 * 256 * 256 * 256
s2 = Int((Sip - s21) / 256 / 256)
s31 = s2 * 256 * 256 + s21
s3 = Int((Sip - s31) / 256)
s4 = Sip - s3 * 256 - s31
deaddr = CStr(s1) + "." + CStr(s2) + "." + CStr(s3) + "." + CStr(s4)
End Function
中.国站长站
站.长.站
示例请参考：http://access911.net/down/eg/User_DHTML_search_IP.rar
Chinaz~com
上述程序会自动去 http://ip.loveroot.com/index.php?job=search 搜索所有的 IP 以及对应的物理地址并保存到数据库中 中国站长.站
修订：刚才上了一下网站，发现界面竟然改了，又重新修改了一下读取页面的程序。
站长.站
关于 WebBrowser 控件的资料请参考 VB6 中 MSDN 的以下章节 中.国站长站
以下为引用的内容：
Internet Client SDK
Internet Tools & Technologies
Reusing the WebBrowser and MSHTML
Chinaz_com
inet401/help/itt/ieprog/IEProg.htm#book_browsing（BOOKMARK
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
