(VB读纯真IP数据库查IP.docxVIP

VB读纯真IP数据库查IP 2009-03-17 22:50纯真IP数据库（QQWry.Dat）放到程序根目录。莢Option ExplicitPrivate Declare Function lstrcat Lib kernel32 Alias lstrcatA (ByVal lpString1 As String, ByVal lpString2 As String) As LongOption Base 0Private Sub Command1_Click()txtAddRess.Text = ipwhere(Text1.Text)End Sub Public Function ipwhere(ipAddress As String)Dim ipbegin, ipend, ipData1, ipData2, DataSeek, ipFlag 縨Dim ipip = Split(ipAddress, .)Dim ipNum 当前要查询的ip ipNum = ip(0) *+ ip(1) * 65536 + ip(2) * 256 + ip(3) Debug.Print ipNumDim ipfile ipfile = App.Path \QQwry.datvb的文件读取方式Dim fn As Integerfn = FreeFile {Open ipfile For Binary Access Read As #fn $Dim ipbegin, ipendDim ipbegin As Long Dim ipend As LongGet #fn, , ipbegin 读文件头4个字节 第一个起始IP的绝对偏移Get #fn, , ipend 再读文件头4个字节 最后一个起始IP的绝对偏移Dim ipbeginArray(1 To 4) As ByteDim ipendArray(1 To 4) As ByteGet #fn, , ipbeginArray()Get #fn, , ipendArray()ipbegin = unPack(ipbeginArray)ipend = unPack(ipendArray)鶶Dim ipAllNum A豃每组ip段占7个字节 计算有多少组ip段 ipAllNum = (ipend - ipbegin) / 7 + 1Dim BeginNum, EndNum %坵9趴BeginNum = 0EndNum = ipAllNumDim Middle ㎝Dim ipData1Dim ipData1Array(1 To 4) As Byte Dim ip1Num ? lBgn: hMiddle = CLng((EndNum + BeginNum) / 2)Get #fn, ipbegin + 7 * Middle + 1, ipData1Array() ipData1 = unPack(ipData1Array)Debug.Print Loc(fn)ip1Num = ipData1If ip1Num ipNum ThenEndNum = MiddleGoTo BgnEnd If Dim DataSeekDim DataSeekArray(1 To 3) As Byte ?Debug.Print Loc(fn)Get #fn, , DataSeekArray()DataSeek = unPack(DataSeekArray)Dim ipData2, ip2NumDim ipData2Array(1 To 4) As ByteGet #fn, DataSeek + 1, ipData2Array()ipData2 = unPack(ipData2Array)ip2Num = ipData2If ip2Num ipNum ThenIf Middle = BeginNum Then GoTo nd BeginNum = MiddleGoTo BgnEnd IfDim ipFlag As ByteDebug.Print Loc(fn)Get #fn, , ipFlagDebug.Print Loc(fn)Dim ipAddr2 As String Dim ipAddr1 As StringIf ipFlag = 1 ThenDim ipSeekDim ipSeekArray(1 To 3) As ByteGet #fn, , ipSeekArray()ipSeek = unPack(ipSeekArray)Get #fn, ipSeek + 1, ipFlagEnd IfIf ipFlag = 2 Then 5Dim AddrSeekDim AddrSeekArray(1 To