Option Compare Database
Dim blnSwitch As Boolean
Private Sub Command1_Click() '用于啟動(dòng)瀏覽功能

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ù)庫(kù)吧
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

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()

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 '搜索完一個(gè)IP以后再搜索下面一個(gè)
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

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

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)

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

Internet Client SDK
Internet Tools & Technologies
Reusing the WebBrowser and MSHTML

inet401/help/itt/ieprog/IEProg.htm#book_browsing（BOOKMARK）