求大神除錯修改
Public Function GetAddress(sip)
If Len(sip) < 5 Then
GetAddress = "輸入IP錯誤！"
Exit Function
End If
On Error Resume Next
Dim Wry, IPType
Set Wry = New ShowIp
If Not Wry.IsIp(sip) Then
GetAddress = " 輸入IP錯誤！"
Exit Function
End If
IPType = Wry.QQWry(sip)
GetAddress = Wry.Country & " " & Wry.LocalStr
End Function
Private Sub Command1_Click() '查詢地址
Text1.Text = GetAddress(Text2)
End Sub
'類模塊,命名為ShowIp
' ============================================
' 變數聲名
' ============================================
Public Country, LocalStr, Buf, OffSet
Private StartIP, EndIP, CountryFlag
Public QQWryFile
Public FirstStartIP, LastStartIP, RecordCount
Private Stream, EndIPOff
' ============================================
' 類模塊初始化
' ============================================
Private Sub Class_Initialize()
On Error Resume Next
Country = ""
LocalStr = ""
StartIP = 0
EndIP = 0
CountryFlag = 0
FirstStartIP = 0
LastStartIP = 0
EndIPOff = 0
QQWryFile = "QQWry.Dat" 'QQ IP庫路徑
End Sub
' ============================================
' IP地址轉換成整數
' ============================================
Function Iptoint(IP) As Single
Dim IPArray, i, Iptoint1 As Single, Iptoint2 As Single, Iptoint3 As Single, Iptoint4 As Single
IPArray = Split(IP, ".", -1)
For i = 0 To 3
If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0
If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i)))
If CInt(IPArray(i)) > 255 Then IPArray(i) = 255
Next
Iptoint1 = CInt(IPArray(3))
Iptoint2 = CInt(IPArray(2)): Iptoint2 = Iptoint2 * 256
Iptoint3 = CInt(IPArray(1)): Iptoint3 = Iptoint3 * 256: Iptoint3 = Iptoint3 * 256
Iptoint4 = CInt(IPArray(0)): Iptoint4 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256
Iptoint = Iptoint1 + Iptoint2 + Iptoint3 + Iptoint4
'這個演算法在VB中會有溢位?不知道什么原因 Iptoint = ((CInt(IPArray(0)) * 256 * 256 + CInt(IPArray(1)) * 256 + CInt(IPArray(2))) * Iptoint + CInt(IPArray(3))
End Function
' ============================================
' 整數逆轉IP地址
' ============================================
Function IntToIP(IntValue)
p4 = IntValue - Fix(IntValue / 256) * 256
IntValue = (IntValue - p4) / 256
p3 = IntValue - Fix(IntValue / 256) * 256
IntValue = (IntValue - p3) / 256
p2 = IntValue - Fix(IntValue / 256) * 256
IntValue = (IntValue - p2) / 256
p1 = IntValue
IntToIP = CStr(p1) & "." & CStr(p2) & "." & CStr(p3) & "." & CStr(p4)
End Function
' ============================================
' 獲取開始IP位置
' ============================================
Private Function GetStartIP(RecNo)
OffSet = FirstStartIP + RecNo * 7
Stream.Position = OffSet
Buf = Stream.Read(7)
FirstStartIP1 = AscB(MidB(Buf, 1, 1))
FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256
FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256
FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256
StartIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4
LastStartIP1 = AscB(MidB(Buf, 5, 1))
LastStartIP2 = AscB(MidB(Buf, 6, 1)): LastStartIP2 = LastStartIP2 * 256
LastStartIP3 = AscB(MidB(Buf, 7, 1)): LastStartIP3 = LastStartIP3 * 256: LastStartIP3 = LastStartIP3 * 256
'LastStartIP4 = AscB(MidB(Buf, 8, 1)): LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256
EndIPOff = LastStartIP1 + LastStartIP2 + LastStartIP3 '+ LastStartIP4
'這個演算法在VB中會有溢位?不知道什么原因 EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256)
'這個演算法在VB中會有溢位?不知道什么原因 StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256)
GetStartIP = StartIP
End Function
' ============================================
' 獲取結束IP位置
' ============================================
Private Function GetEndIP()
Stream.Position = EndIPOff
Buf = Stream.Read(5)
FirstStartIP1 = AscB(MidB(Buf, 1, 1))
FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256
FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256
FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256
EndIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4
'這個演算法在VB中會有溢位?不知道什么原因 EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1)) * 256) + (AscB(MidB(Buf, 3, 1)) * 256 * 256) + (AscB(MidB(Buf, 4, 1)) * 256 * 256 * 256)
CountryFlag = AscB(MidB(Buf, 5, 1))
GetEndIP = EndIP
End Function
' ============================================
' 獲取地域資訊，包含國家和和省市
' ============================================
Private Sub GetCountry(IP)
If (CountryFlag = 1 Or CountryFlag = 2) Then
Country = GetFlagStr(EndIPOff + 4)
If CountryFlag = 1 Then
LocalStr = GetFlagStr(Stream.Position)
' 以下用來獲取資料庫版本資訊
If IP >= Iptoint("255.255.255.0") And IP <= Iptoint("255.255.255.255") Then
LocalStr = GetFlagStr(EndIPOff + 21)
Country = GetFlagStr(EndIPOff + 12)
End If
Else
LocalStr = GetFlagStr(EndIPOff + 8)
End If
Else
Country = GetFlagStr(EndIPOff + 4)
LocalStr = GetFlagStr(Stream.Position)
End If
' 過濾資料庫中的無用資訊
Country = Trim(Country)
LocalStr = Trim(LocalStr)
End Sub
uj5u.com熱心網友回復：
‘接上面
' ============================================
' 獲取IP地址識別符號
' ============================================
Private Function GetFlagStr(OffSet)
Dim Flag
Flag = 0
Do While (True)
Stream.Position = OffSet
Flag = AscB(Stream.Read(1))
If (Flag = 1 Or Flag = 2) Then
Buf = Stream.Read(3)
If (Flag = 2) Then
CountryFlag = 2
EndIPOff = OffSet - 4
End If
FirstStartIP1 = AscB(MidB(Buf, 1, 1))
FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256
FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256
OffSet = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 ' + FirstStartIP4
Else
Exit Do
End If
Loop
If (OffSet < 12) Then
GetFlagStr = ""
Else
Stream.Position = OffSet
GetFlagStr = GetStr()
End If
End Function
' ============================================
' 獲取字串資訊
' ============================================
Private Function GetStr()
Dim c
GetStr = ""
Do While (True)
c = AscB(Stream.Read(1))
If (c = 0) Then Exit Do
'如果是雙位元組，就進行高位元組在結合低位元組合成一個字符
If c > 127 Then
If Stream.EOS Then Exit Do
GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(c)))
Else
GetStr = GetStr & Chr(c)
End If
Loop
End Function
' ============================================
' 核心函式，執行IP搜索
' ============================================
Public Function QQWry(DotIP)
Dim IP, nRet
Dim RangB, RangE, RecNo
Dim FirstStartIP1, FirstStartIP2, FirstStartIP3, FirstStartIP4
Dim LastStartIP1, LastStartIP2, LastStartIP3, LastStartIP4
IP = Iptoint(DotIP)
Set Stream = CreateObject("ADodb.Stream")
Stream.Mode = 3
Stream.Type = 1
Stream.Open
Stream.LoadFromFile QQWryFile
Stream.Position = 0
Buf = Stream.Read(8)
FirstStartIP1 = AscB(MidB(Buf, 1, 1))
FirstStartIP2 = AscB(MidB(Buf, 2, 1)): FirstStartIP2 = FirstStartIP2 * 256
FirstStartIP3 = AscB(MidB(Buf, 3, 1)): FirstStartIP3 = FirstStartIP3 * 256: FirstStartIP3 = FirstStartIP3 * 256
FirstStartIP4 = AscB(MidB(Buf, 4, 1)): FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256
FirstStartIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4
LastStartIP1 = AscB(MidB(Buf, 5, 1))
LastStartIP2 = AscB(MidB(Buf, 6, 1)): LastStartIP2 = LastStartIP2 * 256
LastStartIP3 = AscB(MidB(Buf, 7, 1)): LastStartIP3 = LastStartIP3 * 256: LastStartIP3 = LastStartIP3 * 256
LastStartIP4 = AscB(MidB(Buf, 8, 1)): LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256
LastStartIP = LastStartIP1 + LastStartIP2 + LastStartIP3 + LastStartIP4
'這個演算法在VB中會有溢位?不知道什么原因 LastStartIP = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1)) * 256) + (AscB(MidB(Buf, 7, 1)) * 256 * 256) + (AscB(MidB(Buf, 8, 1)) * 256 * 256 * 256)
RecordCount = Int((LastStartIP - FirstStartIP) / 7)
' 在資料庫中找不到任何IP地址
If (RecordCount <= 1) Then
Country = "未知"
QQWry = 2
Exit Function
End If
RangB = 0
RangE = RecordCount
Do While (RangB < (RangE - 1))
RecNo = Int((RangB + RangE) / 2)
Call GetStartIP(RecNo)
If (IP = StartIP) Then
RangB = RecNo
Exit Do
End If
If (IP > StartIP) Then
RangB = RecNo
Else
RangE = RecNo
End If
Loop
Call GetStartIP(RangB)
Call GetEndIP
If (StartIP <= IP) And (EndIP >= IP) Then
' 沒有找到
nRet = 0
Else
' 正常
nRet = 3
End If
Call GetCountry(IP)
QQWry = nRet
End Function
' ============================================
' 檢查IP地址合法性
' ============================================
Public Function IsIp(IP)
varparts = Split(IP, ".")
Debug.Print UBound(varparts)
If UBound(varparts) <> 3 Then
IsIp = False
Exit Function
End If
For i = 0 To 3
If Val(varparts(i)) > 255 Or Val(varparts(i)) < 0 Then
IsIp = False
Exit Function
Else
IsIp = True
End If
Next i
End Function
' ============================================
' 類終結
' ============================================
Private Sub Class_Terminate()
On Error Resume Next
Stream.Close
If Err Then Err.Clear
Set Stream = Nothing
End Sub
uj5u.com熱心網友回復：
先用單引號注釋掉所有On Error Resume Next陳述句再在VB6 IDE中運行，彈出出錯對話框時點除錯，游標會自動停在當前源代碼行，此時在立即視窗中使用
?運算式
顯示運算式的當前值輔助除錯。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/78300.html
標籤：網絡編程