問題:
如何用 Access 分析一個網(wǎng)站,或者在網(wǎng)站上提交一個查詢,得到結(jié)果后存儲進(jìn)數(shù)據(jù)庫哪?
如何用 Access 下載 DVBBS 論壇上所有的帖子?
如何用 ACCESS 編寫灌水程序?
方法一:
答案非常簡單—— DHTML 編程。
有人可能問了,ACCESS 使用的是 VBA ,而 DHTML 中使用的是 VBS 怎么可能通用哪?其實 VBS / VBA 都是 VB 的子集。在 Access 中只要引用
Microsoft Internet Controls
Microsoft HTML Object Library
即可,然后在窗體上加入 “Microsoft Web 瀏覽器”控件
好了,下面就以我寫的一個讀取某 IP 物理地域查詢網(wǎng)站頁面的數(shù)據(jù)庫為例說明 DHTML / “Microsoft Web 瀏覽器”控件在 ACCESS 的應(yīng)用吧。
“Microsoft Web 瀏覽器”控件的作用是什么哪?主要就是為了獲得 DOCUMENT 對象的,DHTML 的操作都是以 DOCUMENT 對象為運行基礎(chǔ)的。
要完成讀取網(wǎng)頁的功能我們必須了解 DHTML 的幾個簡單的對象以及屬性
1、DOCUMENT 對象:代表這整個 HTML 文檔
2、BODY 對象:是 DOCUMENT 對象的子對象,里面存儲著所有顯示給用戶看的 HTML 代碼
3、innerText 屬性:頁面中顯示給客戶看的文本,注意:不是 HTML 代碼呦
4、innerHTML屬性:構(gòu)成頁面的 HTML 代碼
5、對象.all.length屬性:頁面中所有 element 的個數(shù)。(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, ".")
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
Sub WriteLog(ip1 As String) '讀取結(jié)果
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
'循環(huán) DOCUMENT 中所有的元素獲取需要的字符
For i = 0 To dc.all.length - 1
'由于該服務(wù)器重寫界面,我改了一下分析代碼
'If dc.all(i).tagName = "p" And Left(dc.all(i).innerText, 4) = "查詢結(jié)果" Then
If dc.all(i).tagName = "p" And Left(dc.all(i).innerText, 8) = "官方數(shù)據(jù)查詢結(jié)果" Then
'由于該服務(wù)器重寫界面,我改了一下分析代碼
'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, "查詢結(jié)果:") + 6, InStr(1, dc.all(i).innerText, "(") - InStr(1, dc.all(i).innerText, "查詢結(jié)果:") - 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 終于得到需要的數(shù)據(jù)了,用 SQL 語句直接寫入數(shù)據(jù)庫吧
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 來更改網(wǎng)頁的源代碼,建立一個簡單的 FORM ,然后提交給服務(wù)器,繼續(xù)查詢下面的 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 到服務(wù)器
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 對象
'已經(jīng)完全被客戶端瀏覽器讀取了,我們只要獲取 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
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 進(jìn)去
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 重現(xiàn)轉(zhuǎn)換為字符型的 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 以及對應(yīng)的物理地址并保存到數(shù)據(jù)庫中
修訂:剛才上了一下網(wǎng)站,發(fā)現(xiàn)界面竟然改了,又重新修改了一下讀取頁面的程序。
關(guān)于 WebBrowser 控件的資料請參考 VB6 中 MSDN 的以下章節(jié)
Internet Client SDK
Internet Tools & Technologies
Reusing the WebBrowser and MSHTML
inet401/help/itt/ieprog/IEProg.htm#book_browsing(BOOKMARK)