几年前从某个博客抄来的，已经忘记原地址了，如果需要C#版的，可以在博客园搜到吧。
我因为自己用，所以转换为了VBNET代码，而且也放置了很久，今天无意间翻出来，就分享给大家吧。
首先，先下载 纯真数据库，名称应该是 QQWry.dat 。
之后将数据库文件复制到程序的主目录即可。
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Net
Imports System.Net.Sockets
‘‘‘ <summary>IP地址查询</summary>
Public NotInheritable Class IPQuery
‘‘‘ <summary>IP地址描述</summary>
Public Structure IPLocation
Sub New(ByVal i As String, ByVal c As String, ByVal l As String)
IP = i
Country = c
Local = l
End Sub
‘‘‘ <summary>IP地址</summary>
Dim IP As String
‘‘‘ <summary>地域\国家\机构</summary>
Dim Country As String
‘‘‘ <summary>地域描述</summary>
Dim Local As String
‘‘‘ <summary>返回完整名称</summary>
Overloads Function ToString() As String
Return Me.Country & Me.Local
End Function
‘‘‘ <param name="ls">连接字符</param>
Overloads Function ToString(ByVal ls As String) As String
Return Me.Country & ls & Me.Local
End Function
‘ 强制转换
Public Shared Widening Operator CType(ByVal o As IPLocation) As String
Return o.ToString
End Operator
End Structure
Shared encoding As Encoding = encoding.GetEncoding("GB2312")
Shared ipCount As Integer
Shared fsinoffiset As Integer
Shared lsinoffiset As Integer
Shared data As Byte()
‘ 加强线程访问安全
Shared rwl As New Threading.ReaderWriterLock
‘‘‘ <summary>刷新IP数据库</summary>
Shared Sub ReIPData(ByVal dataPath As String)
rwl.AcquireWriterLock(-1) ‘设置写权限，禁止读权限
‘ 尝试回收内存中的数据库
If data IsNot Nothing Then
data = Nothing
GC.Collect()
End If
‘ 读取数据
data = IO.File.ReadAllBytes(dataPath)
fsinoffiset = CInt(data(0)) + (CInt(data(1)) << 8) + (CInt(data(2)) << 16) + (CInt(data(3)) << 24)
lsinoffiset = CInt(data(4)) + (CInt(data(5)) << 8) + (CInt(data(6)) << 16) + (CInt(data(7)) << 24)
ipCount = (lsinoffiset - fsinoffiset) / 7 + 1
rwl.ReleaseWriterLock()
If ipCount <= 1 Then Throw New ApplicationException("提供的IP数据错误！")
End Sub
Shared Sub New()
‘ TODO 替换为自己的数据库地址
ReIPData(Application.StartupPath & "\QQWry.dat")
End Sub
‘‘‘ <summary>返回数据库中IP纪录总数</summary>
Shared ReadOnly Property Count() As Integer
Get
Return ipCount
End Get
End Property
‘‘‘ <summary>查询一组IP地址</summary>
Shared Function QueryAll(ByVal ParamArray ips As String()) As IPLocation()
If ips Is Nothing OrElse ips.Length = 0 Then Return Nothing
Dim ipls(ips.Length - 1) As IPLocation
For i As Integer = 0 To ips.Length - 1
ipls(i) = Query(ips(i))
Next
Return ipls
End Function
‘‘‘ <summary>查询IP地址</summary>
Shared Function Query(ByVal ip As String) As IPLocation
rwl.AcquireReaderLock(-1) ‘设置读权限
Dim ads As IPAddress = IPAddress.Parse(ip)
If ads.AddressFamily <> AddressFamily.InterNetwork Then Throw New ArgumentException("不支持非IPV4协议")
If IPAddress.IsLoopback(ads) Then
rwl.ReleaseReaderLock()
Return New IPLocation(ip, "本机或保留地址", "")
End If
‘Dim intIp As UInteger = CUInt(IPAddress.HostToNetworkOrder(CInt(ads.Address)))
Dim intIp As UInteger = m_ip2uint(ads.ToString)
Dim iplon As IPLocation : iplon.IP = ip
Dim right As UInteger = ipCount
Dim left, middle, startIp, endIpOff, endIp As UInteger
Dim countryFlag As Integer = 0
While left < (right - 1)
middle = (right + left) / 2
startIp = GetStartIp(middle, endIpOff)
If intIp = startIp Then
left = middle
Exit While
End If
If intIp > startIp Then
left = middle
Else
right = middle
End If
End While
startIp = GetStartIp(left, endIpOff)
endIp = GetEndIp(endIpOff, countryFlag)
If startIp <= intIp And endIp >= intIp Then
Dim local As String = ""
iplon.Country = GetCountry(endIpOff, countryFlag, local)
If local = " CZ88.NET" Then local = "" ‘优化 用于去除部分IP地址返回的广告数据
iplon.Local = local
Else
iplon.Country = "未知地区"
iplon.Local = "" ‘"火星网友"
End If
rwl.ReleaseReaderLock()
Return iplon
End Function
Private Shared Function GetStartIp(ByVal left As UInteger, ByRef endIpOff As UInteger) As UInteger
Dim leftOffset As Integer = CInt(fsinoffiset + (left * 7))
endIpOff = CUInt(data(leftOffset + 4)) + (CUInt(data(leftOffset + 5)) << 8) + (CUInt(data(leftOffset + 6)) << 16)
Return CUInt(data(leftOffset)) + (CUInt(data(leftOffset + 1)) << 8) + (CUInt(data(leftOffset + 2)) << 16) + (CUInt(data(leftOffset + 3)) << 24)
End Function
Private Shared Function GetEndIp(ByVal endIpOff As UInteger, ByRef countryFlag As Integer) As UInteger
countryFlag = data(endIpOff + 4)
Return CUInt(data(endIpOff)) + (CUInt(data(endIpOff + 1)) << 8) + (CUInt(data(endIpOff + 2)) << 16) + (CUInt(data(endIpOff + 3)) << 24)
End Function
Private Shared Function GetCountry(ByVal endIpOff As UInteger, ByVal countryFlag As Integer, ByRef local As String) As String
Dim country As String = ""
Dim offset As UInteger = endIpOff + 4
Select Case countryFlag
Case 1, 2
country = GetFlagStr(offset, countryFlag, endIpOff)
offset = endIpOff + 8
local = IIf(countryFlag = 1, "", GetFlagStr(offset, countryFlag, endIpOff))
Case Else
country = GetFlagStr(offset, countryFlag, endIpOff)
local = GetFlagStr(offset, countryFlag, endIpOff)
End Select
Return country
End Function
Private Shared Function GetFlagStr(ByRef offset As UInteger, ByRef countryFlag As Integer, ByRef endIpOff As UInteger) As String
Dim flag As Integer = 0
Do
flag = data(offset)
If flag <> 1 And flag <> 2 Then Exit Do
If flag = 2 Then
countryFlag = 2
endIpOff = offset - 4
End If
offset = CUInt(data(offset + 1)) + (CUInt(data(offset + 2)) << 8) + (CUInt(data(offset + 3)) << 16)
Loop
If offset < 12 Then Return ""
Return GetStr(offset)
End Function
Private Shared Function GetStr(ByRef offset As UInteger) As String
Dim lowByte As Byte = 0, highByte As Byte = 0
Dim sb As New StringBuilder(16)
Do
lowByte = data(offset) : offset += 1
If lowByte = 0 Then Return sb.ToString
If lowByte > &H7F Then
highByte = data(offset) : offset += 1
If highByte = 0 Then Return sb.ToString
sb.Append(encoding.GetString(New Byte() {lowByte, highByte}))
Else
sb.Append(ChrW(lowByte))
End If
Loop
End Function
‘‘‘ <summary>将ip地址转换为uint</summary>
Private Shared Function m_ip2uint(ByVal ip As String) As UInteger
Dim bs As Byte() = IPAddress.Parse(ip).GetAddressBytes
Return CUInt(bs(3)) + (CUInt(bs(2)) << 8) + (CUInt(bs(1)) << 16) + (CUInt(bs(0)) << 24)
End Function
End Class
如果你要设置自定义的数据库位置，记得修改 Shared Sub New 这个方法，或者干脆删除它，自己调用 ReIPData 来设置数据库的地址。
使用方法很简单，如下：
Dim iploca = IPQuery.Query("127.0.0.1")
Dim ipdesc = String.Format("IP {0} 的详细地址为: {1} - {2}", iploca.IP, iploca.Country, iploca.Local)
时间： 2024-08-25 09:11:30