Imports Microsoft.VisualBasic
Imports System.IO

'辅助类，用于保存IP索引信息
Public Class CZ_INDEX_INFO

    Public IpSet As UInt32
    Public IpEnd As UInt32
    Public Offset As UInt32

    Sub New()
        IpSet = 0
        IpEnd = 0
        Offset = 0
    End Sub

End Class

'读取纯真IP数据库类
Public Class PHCZIP

    Protected bFilePathInitialized As Boolean
    Protected FilePath As String
    Protected FileStrm As FileStream

    Protected Index_Set As UInt32
    Protected Index_End As UInt32
    Protected Index_Count As UInt32

    Protected Search_Index_Set As UInt32
    Protected Search_Index_End As UInt32
    Protected Search_Set As CZ_INDEX_INFO
    Protected Search_Mid As CZ_INDEX_INFO
    Protected Search_End As CZ_INDEX_INFO

    Public Sub New()
        bFilePathInitialized = False
    End Sub

    Public Sub New(ByVal dbFilePath As String)
        bFilePathInitialized = False
        SetDbFilePath(dbFilePath)
    End Sub


    '使用二分法查找索引区，初始化查找区间
    Protected Sub Initialize()
        Search_Index_Set = 0
        Search_Index_End = Index_Count - 1
    End Sub

    '关闭文件
    Public Sub Dispose()
        If (bFilePathInitialized) Then
            bFilePathInitialized = False
            FileStrm.Close()
            FileStrm.Dispose()
        End If
    End Sub

    '设置纯真IP数据库的文件路径
    Public Function SetDbFilePath(ByVal dbFilePath As String) As Boolean

        If (dbFilePath = "") Then
            Return False
        End If

        'Try
        '打开数据文件

        FileStrm = New FileStream(dbFilePath, FileMode.Open, FileAccess.Read)
        'Catch
        'Return False
        'End Try

        '检查文件长度
        If (FileStrm.Length < 8) Then
            FileStrm.Close()
            FileStrm.Dispose()
            Return False
        End If

        '得到第一条索引的绝对偏移和最后一条索引的绝对偏移
        FileStrm.Seek(0, SeekOrigin.Begin)

        Index_Set = GetUInt32()
        Index_End = GetUInt32()

        '得到总索引条数
        Index_Count = (Index_End - Index_Set) / 7 + 1
        bFilePathInitialized = True

        Return True

    End Function

    '主接口函数，根据传入的IP返回该IP的地址信息
    Public Function GetAddressWithIP(ByVal IPvalue As String) As String

        If Not bFilePathInitialized Then
            Return ""
        End If

        Initialize()

        '将IP转化为数字
        Dim ip As UInt32 = IPToUInt32(IPvalue)

        While (True)

            '首先初始化本轮查找的区间

            '区间头
            Search_Set = IndexInfoAtPos(Search_Index_Set)
            '区间尾
            Search_End = IndexInfoAtPos(Search_Index_End)

            '判断IP是否在区间头内
            If (ip >= Search_Set.IpSet And ip <= Search_Set.IpEnd) Then
                Return ReadAddressInfoAtOffset(Search_Set.Offset)
            End If

            '判断IP是否在区间尾内
            If (ip >= Search_End.IpSet And ip <= Search_End.IpEnd) Then
                Return ReadAddressInfoAtOffset(Search_End.Offset)
            End If

            '计算出区间中点
            Search_Mid = IndexInfoAtPos((Search_Index_End + Search_Index_Set) / 2)

            '判断IP是否在中点
            If (ip >= Search_Mid.IpSet And ip <= Search_Mid.IpEnd) Then
                Return ReadAddressInfoAtOffset(Search_Mid.Offset)
            End If

            '本轮没有找到，准备下一轮
            If (ip < Search_Mid.IpSet) Then
                'IP比区间中点要小，将区间尾设为现在的中点，将区间缩小1倍。
                Search_Index_End = (Search_Index_End + Search_Index_Set) / 2
            Else
                'IP比区间中点要大，将区间头设为现在的中点，将区间缩小1倍。
                Search_Index_Set = (Search_Index_End + Search_Index_Set) / 2
            End If

        End While

        Return ""

    End Function

    '读取指定文件偏移位置的国家和地区信息
    Protected Function ReadAddressInfoAtOffset(ByVal Offset As UInt32) As String

        Dim country As String = ""
        Dim area As String = ""
        Dim country_Offset As UInt32 = 0
        Dim Tag As Byte = 0
        '跳过4字节，因这4个字节是该索引的IP区间上限。
        FileStrm.Seek(Offset + 4, SeekOrigin.Begin)

        '读取一个字节，得到描述国家信息的“寻址方式”
        Tag = GetTag()

        If (Tag = &H1) Then

            '模式0x01，表示接下来的3个字节是表示偏移位置
            FileStrm.Seek(GetOffset(), SeekOrigin.Begin)

            '继续检查“寻址方式”
            Tag = GetTag()
            If (Tag = &H2) Then
                '模式0x02，表示接下来的3个字节代表国家信息的偏移位置
                '先将这个偏移位置保存起来，因为我们要读取它后面的地区信息。
                country_Offset = GetOffset()
                '读取地区信息（注：按照Luma的说明，好像没有这么多种可能性，但在测试过程中好像有些情况没有考虑到，
                '所以写了个ReadArea()来读取。
                area = ReadArea()
                '读取国家信息
                FileStrm.Seek(country_Offset, SeekOrigin.Begin)
                country = ReadString()

            Else
                '这种模式说明接下来就是保存的国家和地区信息了，以'\0'代表结束。
                FileStrm.Seek(-1, SeekOrigin.Current)
                country = ReadString()
                area = ReadArea()

            End If

        ElseIf (Tag = &H2) Then
            '模式0x02，说明国家信息是一个偏移位置
            country_Offset = GetOffset()
            '先读取地区信息
            area = ReadArea()
            '读取国家信息
            FileStrm.Seek(country_Offset, SeekOrigin.Begin)
            country = ReadString()

        Else
            '这种模式最简单了，直接读取国家和地区就OK了
            FileStrm.Seek(-1, SeekOrigin.Current)
            country = ReadString()
            area = ReadArea()

        End If

        Return country + " " + area

    End Function

    '从当前位置读取一个字符串（国家或者地区信息）
    Protected Function ReadString() As String

        Dim Offset As UInt32 = 0
        Dim TempByteArray(256) As Byte
        TempByteArray(Offset) = FileStrm.ReadByte()
        While (TempByteArray(Offset) <> &H0)
            Offset += 1
            TempByteArray(Offset) = FileStrm.ReadByte()
        End While

        Return System.Text.Encoding.Default.GetString(TempByteArray)

    End Function

    '从当前文件位置读取地区信息
    Protected Function ReadArea() As String

        Dim Tag As Byte = GetTag()

        If (Tag = &H1 or Tag = &H2) Then
            FileStrm.Seek(GetOffset(), SeekOrigin.Begin)
            Return ReadString()
        Else
            FileStrm.Seek(-1, SeekOrigin.Current)
            Return ReadString()
        End If

    End Function

    '从当前文件位置读取一个字节的标识
    Protected Function GetTag() As Byte
        Return FileStrm.ReadByte()
    End Function

    '得到指定索引位置的信息（IP起始范围）
    Protected Function IndexInfoAtPos(ByVal Index_Pos As Int32) As CZ_INDEX_INFO

        Dim Index_Info As New CZ_INDEX_INFO
        '根据索引编号计算出在文件中在偏移位置
        FileStrm.Seek(Index_Set + 7 * Index_Pos, SeekOrigin.Begin)
        Index_Info.IpSet = GetUInt32()
        Index_Info.Offset = GetOffset()
        FileStrm.Seek(Index_Info.Offset, SeekOrigin.Begin)
        Index_Info.IpEnd = GetUInt32()

        Return Index_Info

    End Function

    '读取3个字节，得到偏移位置
    Protected Function GetOffset() As UInt32

        Dim TempByte4(4) As Byte
        TempByte4(0) = FileStrm.ReadByte()
        TempByte4(1) = FileStrm.ReadByte()
        TempByte4(2) = FileStrm.ReadByte()
        TempByte4(3) = 0
        Return BitConverter.ToUInt32(TempByte4, 0)

    End Function

    Protected Function GetUInt32() As UInt32

        Dim TempByte4(4) As Byte
        FileStrm.Read(TempByte4, 0, 4)
        Return BitConverter.ToUInt32(TempByte4, 0)

    End Function


    '将字符串的IP转换成Int32
    Public Shared Function IPToUInt32(ByVal Ipvalue As String) As UInt32

        Dim IpByte() As String = Ipvalue.Split(".")
        Dim nUpperBound As Int32 = IpByte.GetUpperBound(0)
        If nUpperBound <> 3 Then
            ReDim Preserve IpByte(4)
            For i As Int32 = 1 To 3 - nUpperBound
                IpByte(nUpperBound + i) = "0"
            Next
        End If

        Dim TempByte4(4) As Byte
        For i As Int32 = 0 To 3
            '如果是.Net 2.0可以支持TryParse。
            'If Not (Byte.TryParse(IpByte(i), TempByte4(3 - i))) Then
            'TempByte4(3 - i) = &H0
            'End If
            If (IsNumeric(IpByte(i))) Then
                TempByte4(3 - i) = CInt(IpByte(i)) And &HFF
            End If
        Next

        Return BitConverter.ToUInt32(TempByte4, 0)
        'System.Net.IPAddress.NetworkToHostOrder
    End Function

    '将Int32型的IP转换成字符串
    Public Shared Function UInt32ToIP(ByVal UInt32value As UInt32) As String
        Return New System.Net.IPAddress(System.Net.IPAddress.HostToNetworkOrder(UInt32value)).ToString()
    End Function

End Class

Dim qq As PHCZIP = New PHCZIP(Server.MapPath("QQWry.Dat"))
Dim address As String = qq.GetAddressWithIP("211.138.147.158")
Response.Write(address)