纯真IP数据库查询IP地理位置代码

1、纯真IP数据库查询IP地理位置代码'使用该函数查询Public Function GetAddress(sip)     If Len(sip) < 5 Then         GetAddress = "输入IP错误！"         Exit Function     End If   

2、  On Error Resume Next     Dim Wry, IPType     Set Wry = New ShowIp     If Not Wry.IsIp(sip) Then         GetAddress = " 输入IP错误！"         Exit Fu

3、nction     End If     IPType = Wry.QQWry(sip)     GetAddress = Wry.Country & " " & Wry.LocalStrEnd Function'类模块,命名为ShowIp' =     ' 变量声名     ' =    

4、; Public Country, LocalStr, Buf, OffSet     Private StartIP, EndIP, CountryFlag     Public QQWryFile     Public FirstStartIP, LastStartIP, RecordCount     Private Stream, EndIPOff     ' = 

5、60;   ' 类模块初始化     ' =     Private Sub Class_Initialize()         On Error Resume Next         Country = ""       

6、60; LocalStr = ""         StartIP = 0         EndIP = 0         CountryFlag = 0         FirstStartIP = 0    &#

7、160;    LastStartIP = 0         EndIPOff = 0        QQWryFile = "QQWry.Dat" 'QQ IP库路径     End Sub     ' =     ' IP地址转换成整数&#

8、160;    ' =     Function Iptoint(IP) As Single         Dim IPArray, i, Iptoint1 As Single, Iptoint2 As Single, Iptoint3 As Single, Iptoint4 As Single         IPArray = Split(IP, &qu

9、ot;.", -1)         For i = 0 To 3             If Not IsNumeric(IPArray(i) Then IPArray(i) = 0             If CInt(IPArray(i) < 0 The

10、n IPArray(i) = Abs(CInt(IPArray(i)             If CInt(IPArray(i) > 255 Then IPArray(i) = 255         Next         Iptoint1 = CInt(IPArray(3)  

11、0;      Iptoint2 = CInt(IPArray(2): Iptoint2 = Iptoint2 * 256         Iptoint3 = CInt(IPArray(1): Iptoint3 = Iptoint3 * 256: Iptoint3 = Iptoint3 * 256         Iptoint4 = CInt(IPArray(0): Iptoint4

12、 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256: Iptoint4 = Iptoint4 * 256         Iptoint = Iptoint1 + Iptoint2 + Iptoint3 + Iptoint4         '这个算法在VB中会有溢出?不知道什么原因 Iptoint = (CInt(IPArray(0) * 256 * 256 + CInt(IPArray(

13、1) * 256 + CInt(IPArray(2) * Iptoint + CInt(IPArray(3)     End Function     ' =     ' 整数逆转IP地址     ' =     Function IntToIP(IntValue)         p4 = I

14、ntValue - Fix(IntValue / 256) * 256         IntValue = (IntValue - p4) / 256         p3 = IntValue - Fix(IntValue / 256) * 256         IntValue = (IntValue - p3) / 256  &

15、#160;      p2 = IntValue - Fix(IntValue / 256) * 256         IntValue = (IntValue - p2) / 256         p1 = IntValue         IntToIP = CStr(p1) & "

16、." & CStr(p2) & "." & CStr(p3) & "." & CStr(p4)     End Function     ' =          FirstStartIP4 = AscB(MidB(Buf, 4, 1): FirstStartIP4 = FirstStartIP4 * 256: FirstStar

17、tIP4 = FirstStartIP4 * 256: FirstStartIP4 = FirstStartIP4 * 256         FirstStartIP = FirstStartIP1 + FirstStartIP2 + FirstStartIP3 + FirstStartIP4                  LastStart

18、IP1 = 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&

19、#160;        LastStartIP4 = AscB(MidB(Buf, 8, 1): LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256: LastStartIP4 = LastStartIP4 * 256         LastStartIP = LastStartIP1 + LastStartIP2 + LastStartIP3 + Last

20、StartIP4                 '这个算法在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)    

21、              RecordCount = Int(LastStartIP - FirstStartIP) / 7)         ' 在数据库中找不到任何IP地址         If (RecordCount <= 1) Then    

22、         Country = "未知"             QQWry = 2             Exit Function         End If

23、0;                 RangB = 0         RangE = RecordCount                  Do While (RangB <

24、(RangE - 1)             RecNo = Int(RangB + RangE) / 2)             Call GetStartIP(RecNo)             If (IP = StartIP)

25、 Then                 RangB = RecNo                 Exit Do             End If&#

26、160;            If (IP > StartIP) Then                 RangB = RecNo             Else   

27、;              RangE = RecNo             End If         Loop            

28、60;     Call GetStartIP(RangB)         Call GetEndIP         If (StartIP <= IP) And (EndIP >= IP) Then             ' 没有找到 

29、60;           nRet = 0         Else             ' 正常             nRet = 3  &

30、#160;      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