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