[VB. NET] queries IP addresses and information using the pure ip database, and queries IP addresses using the vb.net database.

[VB. NET] queries IP addresses and information using the pure ip database, and queries IP addresses using the vb.net database.

I copied it from a blog a few years ago and forgot the original address. If you need the C # version, you can find it in the blog.
I used it myself, so I switched it to VBNET code and put it for a long time. I accidentally turned it out today and shared it with you.

First, download the pure database named QQWry. dat.
Then copy the database file to the main directory of the program.

Imports System. IOImports System. textImports System. text. regularExpressionsImports System. netImports System. net. sockets ''' <summary> ip address query </summary> Public NotInheritable Class IPQuery ''' <summary> ip address description </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 address </summary> Dim IP As String ''' <summary> Region \ Country \ institution </summary> Dim Country As String ''' <summary> region description </summary> Dim Local As String ''' <summary> returns the complete name </ summary> Overloads Function ToString () as String Return Me. country & Me. local End Function ''' <param name = "ls"> connection character </param> Overloads Function ToString (ByVal ls As String) As String Return Me. country & ls & Me. local End Function 'forcibly converts Public Shared Widening Operator CType (ByVal o As IPLo Cation) 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 () 'enhances thread access security Shared rwl As New Threading. readerWriterLock ''' <summary> refresh the IP database </summary> Shared Sub ReIPData (ByVal dataPath As String) rwl. acquireWriterLock (-1) 'sets the write permission and disables Read Permission 'try to reclaim the database in memory If data IsNot Nothing Then data = Nothing GC. collect () End If 'reads 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 ipCo Unt <= 1 Then Throw New ApplicationException ("IP data error! ") End Sub Shared Sub New () 'todo is replaced with your own database address ReIPData (Application. startupPath & "\ QQWry. dat ") End Sub ''' <summary> returns the total number of IP records in the database </summary> Shared ReadOnly Property Count () as Integer Get Return ipCount End Get End Property ''' <summary> query a group of IP addresses </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> Query ip addresses </summary> Shared Function Query (ByVal ip As String) As IPLocation rwl. acquireReaderLock (-1) 'sets the read permission Dim ads As IPAddress = IPAddress. parse (ip) If ads. addressFamily <> AddressFamily. interNetwork Then Throw New ArgumentException ("non-IPV4 protocol not supported") If IPAddress. isLoopback (ads) Then rwl. releaseReaderLock () Return New IPLocation (ip, "Local or reserved address", "") 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 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 = "" 'optimizes iplon for removing AD data returned by some IP addresses. local = local Else iplon. country = "Unknown Region" iplon. local = "" '"Mars Netizens" 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> & policf 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> converts an ip address to a 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 FunctionEnd Class

If you want to set a custom database location, remember to modify the Shared Sub New method, or simply delete it and call ReIPData to set the database address.

 

The usage is simple as follows:

Dim iploca = IPQuery. query ("127.0.0.1") Dim ipdesc = String. format ("IP {0} detailed address: {1}-{2}", iploca. IP, iploca. country, iploca. local)