用Access分析网站实例方法

作者：课课家来源： http://www.kokojia.com/点击数：796发布时间： 2015-11-26 16:18:30

今天由小编为大家讲解有关语言编程的文章，在课课家共同了解语言编程其中不被重视的技巧相信对大家一定有很大的帮助

如何用分析一个网站，或者在网站上提交一个查询，得到结果后存储进哪？
如何用 Access 下载 DBS 论坛上所有的帖子？
如何用 ACCESS 编写灌水程序？
方法一：
答案非常简单—— DHTML 编程。
有人可能问了，ACCESS 使用的是 VBA ，wordpress教程而 DHTML 中使用的是 VBS 怎么可能通用哪？其实 VBS / VBA 都是 VB 的子集。在 Access 中只要引用

Microsoft Internet Controls
Microsoft HTML Object Library
即可，然后在窗体上加入 “Microsoft Web 浏览器”控件
好了，下面就以我写的一个读取某 IP 物理地域查询网站页面的数据库为例说明 DHTML / “Microsoft Web 浏览器”控件在 ACCESS 的应用吧。
“Microsoft Web 浏览器”控件的作用是什么哪？主要就是为了获得 DOCUMENT 对象的，DHTML 的操作都是以 DOCUMENT 对象为运行基础的。
要完成读取网页的功能我们必须了解 DHTML 的几个简单的对象以及属性
1、DOCUMENT 对象：代表这整个 HTML 文档
2、BODY 对象：是 DOCUMENT 对象的子对象，里面存储着所有显示给用户看的 HTML 代码
3、innerText 属性：页面中显示给客户看的文本，注意：不是 HTML 代码呦
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.?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)         '读取结果
    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)
            '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

"我从事编程语言统计很多年了，有大量的数据来源包括代码存储库、Q&A讨论、招聘广告、社交媒体情况、教程页面访问、学习视频视图、开发者调查等等。数据发表在不同的时间，都可以被认为是精确的，
也可以被认为是有缺陷的，但是它们可以用于发现行业趋势。最后，不要期望一夜之间就变成一个编码忍者。有些人有一种天然的能力，但也是花了很多很多时间来磨练他们的技能，不断的学习新的技术和技巧。"
在过去三年中 XML 经历了许多反复，所以目前存在不同版本的 Microsoft XML 分析器也不奇怪。Internet Explorer 4.0 包含早期版本的 XML 分析器，它比 XSL、XML 数据或者大多数其他的 XML 技术（并且有完全不同的 DOM 模型）要早。该早期版本的分析器包含在 MSXML.dll 库中。从 MSDN XML 开发人员中心（英文）可将分析器升级到较新的一种。
　　我们极力建议您升级到新的分析器，因为它要强大得多。Internet Explorer 5.0 包括 MSXML 2.0 分析器，它包含 XSL 和 XML 架构的基本版本。MSXML2 是 SQL Server 2000 附带的分析器版本。MSXML2 包含了许多性能增强的功能，并且在总体上提高了性能和可伸缩性。MSXML3 是当前作为“技术预览”附带的版本。MSXML3 包括 XSLT 和 XPath 支持以及 SAX 接口。
利用 DHTML 的 innerHTML 来更改网页的源代码，网页设计入门建立一个简单的 FORM ，然后提交给服务器，继续查询下面的 IP

以下为引用的内容：
    Bd.innerHTML = ""
    '在 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
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

以下代码请新建一个模块后axurerp7.0视频教程 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）

看完小编的文章是不是很精彩，是不是想要成为编程语言的高手，更多关于在线教育的文章尽在课课家，希望你们多多关注。

踩(1)

分享到：

上一篇：新手通过实例学习动态网页PHP的语法总结

下一篇：初见python你对它了解多少？