数据库学习:用Access分析网站实例
问题：
如何用 Access分析一个网站，或者在网站上提交一个查询，得到结果后存储进数据库哪？
如何用 Access 下载 DVBBS 论坛上所有的帖子？
如何用 ACCESS 编写灌水程序？
方法一：
答案非常简单—— DDocument
Dim Bd As MSBody
Dim El As MSElementCollection
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)
'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
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")
End Sub
Private Sub WebBrowser3_DownloadComplete()
'该事件在页面成功下载到本地时运行，这时候 DOCUMENT 对象
'已经完全被客户端浏览器读取了，我们只要获取 Body 对象中的 innerHTML 即可
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
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 进去
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
'用代理无法连接的问题还要解决
'将字符的 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)
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
Dim s1, s21, s2, s31, s3, s4
Sip = Sip + 1
s1 = Int(Sip / 256 / 256 / 256)
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
上述程序会自动去 http://ip.loveroot.com/index.php?job=search 搜索所有的 IP 以及对应的物理地址并保存到数据库中
修订：刚才上了一下网站，发现界面竟然改了，又重新修改了一下读取页面的程序。
关于 WebBrowser 控件的资料请参考 VB6 中 MSDN 的以下章节
Internet Client SDK
Internet Tools & Technologies
Reusing the WebBrowser and MSHTML
inet401/help/itt/ieprog/IEProg.htm#book_browsing（BOOKMARK）
- 最新文章
- 数据库学习:查询区分大小写[01-08]
- 将表中字段转换,并保留原值[01-08]
- 数据库学习:在视图中用order by[01-08]
- 用interbase做数据库[01-08]
- WebSphere数据库更新技巧二则[01-08]
- 对Spfile之参数错误修改的解决办法[01-08]
- 相关文章
- 数据库学习:查询区分大小写[01-08]
- 数据库学习:在视图中用order by[01-08]
- 用interbase做数据库[01-08]
- WebSphere数据库更新技巧二则[01-08]
- 数据库基础学习:并发问题详述[01-08]
- 数据库中几个表之间的关联查询[01-08]
