IP地址物理位置查询(纯真IP数据库)
<%'┌──────────────────────────────────────────┐
'│类名:ipLocater_Class │
'│作用:获取IPAddress所在国家地区 │
'│ 属性: │
'│ ·RecordCount | IP记录总数 │
'│ ·IndexNo | IPAddress所在的索引记录 │
'│ │
'│ 方法: │
'│ ·LoadFromFile() | 装载IP数据库文件(纯真IP数据库格式) │
'│ ·GetIpTablebyIndex() | 获取IP表详细信息 │
'│ ·GetIpAddr() | 获取IP国家地区 │
'├──────────────────────────────────────────┤
'│注: │
'│ 本代码属于免费代码,可以任意拷贝使用,产生的一切后果将由您自己承担。 │
'│ 本代码关联的数据库以"纯真IP数据库"为基础,一切使用权归“纯真网络”所有。 │
'├──────────────────────────────────────────┤
'│附: │
'│ 纯真IP数据库下载地址：http://www. (QQWry.Dat) │
'│ 作者：cen8c QQ:40153823 EMail:cen8c@ │
'│ 日期:2008-05-17 │
'└──────────────────────────────────────────┘
'Option Explicit '显示声明
' 函数名称： NumberToIpAddress()
' 函数原型： NumberToIpAddress(ipNumber As long)
' 功 能： 将数字转化为IP地址
' 参 数： ipNumber 待转化的IP地址
' 返 回 值： IP字符串
' 涉及的表： 无
Private Function NumberToIpAddress(ipNumber)
Dim arrayTemp(4)
Dim ipHigh, ipLow, iCnt
ipHigh = ipNumber / 65536
ipLow = ipNumber - Fix(ipHigh) * 65536
arrayTemp(0) = (ipHigh And &HFF00) / 256
arrayTemp(1) = ipHigh And &H00FF
arrayTemp(2) = (ipLow And &HFF00) / 256
arrayTemp(3) = ipLow And &H00FF
NumberToIpAddress=CStr(arrayTemp(0)) & "." & CStr(arrayTemp(1)) & "." & CStr(arrayTemp(2)) & "." & CStr(arrayTemp(3))
End Function
'/////////////
' 函数名称： IPAddressToNumber()
' 函数原型： IPAddressToNumber(IPAddress As String)
' 功 能： 将IP地址转化为数字
' 参 数： IPAddress 待转化的IP地址
' 返 回 值： Double类型的数字
' 涉及的表： 无
Private Function IPAddressToNumber(IPAddress)
Dim arrayTemp
arrayTemp = Split(IPAddress,".")
If UBound(arrayTemp) <> 3 Then
Err.Raise 1234, "IPAddressToNumber()","参数不是合法的IP地址值：[" & IPAddress & "]"
Exit Function
End If
IPAddressToNumber = CDbl(arrayTemp(3))
IPAddressToNumber = IPAddressToNumber + CDbl(arrayTemp(2) * 256)
IPAddressToNumber = IPAddressToNumber + CDbl(arrayTemp(1) * 256 * 256)
IPAddressToNumber = IPAddressToNumber +CDbl(arrayTemp(0) * 256 * 256 * 256)
End Function
'//
' 函数名称： BinaryToString()
' 函数原型： BinaryToString(bin)
' 功 能： 将二进制转为 string|gb2312 编码
' 参 数： bin 待转化二进制
' 返 回 值： String|gb2312类型
' 涉及的表： 无
Private Function BinaryToString(bin)
Dim i, iByt, sByt, bLen, strto
bLen = lenB(bin)
strto = ""
For i = 1 to bLen
sByt = midB(bin,i,1)
iByt = ascB(sByt)
if iByt<128 then
strto = strto & chr(iByt)
else
strto = strto & chr(ascW(midB(bin, i + 1, 1) & sByt))
i = i + 1
end if
Next
BinaryToString = strto
End Function
''/////////////////////////////////
''/////////////////////////////////
Class ipLocater_Class
Dim FipDB, FDbPath, FIndexStart, FIndexEnd, OIndexLen, i, Re_temp
Dim FIntegerAr(3)
Public RecordCount, IndexNo
Private Sub Class_Initialize()
OIndexLen = 7
Set FipDB = Server.CreateObject("adodb.stream")
FipDB.Mode = 3
FipDB.Type = 1
FipDB.Open()
LoadFromFile(Server.MapPath("QQWry.Dat"))
IndexNo = -1 ''查找IP的索引值
End Sub
''//////
Private Sub Class_Terminate
FipDB.Close
Set FipDB = nothing
End Sub
'//
' 函数名称： GetLong3()
' 函数原型： GetLong3(offset As Integer)
' 功 能： 从offset位置读取3个字节为一个long
' 参 数： offset 整数的起始偏移
' 返 回 值： long类型
' 涉及的表： 无
Private Function GetLong3(offset)
Dim Long3Ar(2)
if offset > 0 then FipDB.Position = offset
For i = 0 To 2
Re_temp = FipDB.Read(1)
Long3Ar(i) = AscB(Re_temp)
Next
GetLong3 = GetLong3A(Long3Ar)
End Function
'//
' 函数名称： GetLong3A()
' 函数原型： GetLong3A(ArrByte As Array)
' 功 能： 3个字节转换成一个long
' 参 数： ArrByte 3个字节数组
' 返 回 值： long类型
' 涉及的表： 无
Private Function GetLong3A(ArrByte)
GetLong3A = ArrByte(0) And &HFF
GetLong3A = GetLong3A + ((ArrByte(1) * 256) And &HFF00)
GetLong3A = GetLong3A + ((ArrByte(2) * 256 * 256) And &HFF0000)
End Function
'//
' 函数名称： IndexWhy()
' 函数原型： IndexWhy(Index As Integer, Long3 As Boolean)
' 功 能： 1.给定一个Index索引,得到开始IPNumber与结束IPNumber,形成IPNumber范围.
' 2.开始IPNumber的3个字节的long
' 参 数： Index 绝对索引记录数, Long3是否返回long的3个字节, EndIP是否返回结束IPNumber
' 返 回 值： Array类型长度3. 位数: 0.开始IPNumber; 1.开始IPNumber的3个字节的long; 2.结束IPNumber.
' 涉及的表： 无
Private Function IndexWhy(Index, Long3, EndIP)
'//ResultAr["StartIPNumber", "StartIPIndex", "EndIPNumber"]
Dim ResultAr(2), Long3Ar(2)
FipDB.Position = FIndexStart + Index * OIndexLen
''开始IP
For i = 0 To 3
Re_temp = FipDB.Read(1)
FIntegerAr(i) = AscB(Re_temp)
Next
ResultAr(0) = FIntegerAr(0) + FIntegerAr(1) * 256
ResultAr(0) = ResultAr(0) + FIntegerAr(2) * 256 * 256 + FIntegerAr(3) * 256 * 256 * 256
if CBool(Long3) then
'3个字节的long
ResultAr(1) = GetLong3(0)
else
FipDB.Position = FipDB.Position + 3
ResultAr(1) = 0
end if
if CBool(EndIP) then
''结束IP
if Index >= RecordCount then
ResultAr(2) = IPAddressToNumber("255.255.255.255")
else
For i = 0 To 3
Re_temp = FipDB.Read(1)
FIntegerAr(i) = AscB(Re_temp)
Next
ResultAr(2) = FIntegerAr(0) + FIntegerAr(1) * 256
ResultAr(2) = ResultAr(2) + FIntegerAr(2) * 256 * 256 + FIntegerAr(3) * 256 * 256 * 256
ResultAr(2) = ResultAr(2) - 1
end if
else
FipDB.Position = FipDB.Position + 4 '这句: 可要可不要
ResultAr(2) = 0
end if
IndexWhy = ResultAr
End Function
'//
' 函数名称： GetAddr()
' 函数原型： GetAddr(offset As Integer)
' 功 能： 给定一个ip国家地区记录的偏移, 得到IP所在国家地区
' 参 数： offset 国家记录的起始偏移
' 返 回 值： Array类型长度2. 位数: 0.国家; 1.地区.
' 涉及的表： 无
Private Function GetAddr(offset)
Dim by, by2, p
'AddrInfo["Country", "Area"]
Dim AddrInfo(1)
FipDB.Position = offset + 4
Re_temp = FipDB.Read(1)
by = AscB(Re_temp)
Select Case by
Case 1
p = GetLong3(0)
FipDB.Position = p
Re_temp = FipDB.Read(1)
by2 = AscB(Re_temp)
if by2 = 2 then
AddrInfo(0) = GetString(GetLong3(0))
FipDB.Position = p + 4
else
AddrInfo(0) = GetString(p)
End if
AddrInfo(1) = GetAreaAddr(0)
Case 2
AddrInfo(0) = GetString(getLong3(0))
AddrInfo(1) = GetAreaAddr(offset + 8)
Case else
AddrInfo(0) = GetString(offset+4)
AddrInfo(1) = GetAreaAddr(0)
End Select
GetAddr = AddrInfo
End Function
'//
' 函数名称： GetAreaAddr()
' 函数原型： GetAreaAddr(offset As Integer)
' 功 能： 从offset偏移开始解析后面的字节，读出一个地区名
' 参 数： offset 国家记录的起始偏移
' 返 回 值： String 地区名字符串
' 涉及的表： 无
Private Function GetAreaAddr(offset)
Dim by, p
if offset > 0 then FipDB.Position = offset
Re_temp = FipDB.Read(1)
by = AscB(Re_temp)
Select Case by
Case 1, 2
p = GetLong3(0)
if p > 0 then
GetAreaAddr = GetString(p)
else
GetAreaAddr = ""
end if
Case else
FipDB.Position = FipDB.Position - 1
GetAreaAddr = GetString(offset)
End Select
End Function
'//
' 函数名称： GetString()
' 函数原型： GetString(offset As Integer)
' 功 能： 从offset偏移处读取一个以0结束的字符串
' 参 数： offset 字符串起始偏移
' 返 回 值： String 读取的字符串
' 涉及的表： 无
Private Function GetString(offset)
Dim by
if offset > 0 then FipDB.Position = offset
Do While True
Re_temp = FipDB.Read(1)
by = AscB(Re_temp)
if by = 0 then
Exit Do
end if
GetString = GetString & ChrB(by)
Loop
End Function
'////
' 过程名称： LoadFromFile()
' 过程原型： LoadFromFile(FileName As String)
' 功 能： 装载IP数据库文件(纯真IP数据库格式)
' 参 数： FileName 数据库文件路径
' 返 回 值： 无
' 涉及的表： 无
Public Sub LoadFromFile(FileName)
FDbPath = FileName
on Error resume next
FipDB.LoadFromFile(FDbPath)
FipDB.Position = 0
''IndexStart开始索引
For i = 0 To 3
Re_temp = FipDB.Read(1)
FIntegerAr(i) = AscB(Re_temp)
Next
FIndexStart = FIntegerAr(0) + FIntegerAr(1) * 256
FIndexStart = FIndexStart + FIntegerAr(2) * 256 * 256 + FIntegerAr(3) * 256 * 256 * 256
''IndexStart结束索引
For i = 0 To 3
Re_temp = FipDB.Read(1)
FIntegerAr(i) = AscB(Re_temp)
Next
FIndexEnd = FIntegerAr(0) + FIntegerAr(1) * 256
FIndexEnd = FIndexEnd + FIntegerAr(2) * 256 * 256 + FIntegerAr(3) * 256 * 256 * 256
RecordCount = (FIndexEnd - FIndexStart) / OIndexLen
End Sub
'////
' 过程名称： GetIpTablebyIndex()
' 过程原型： GetIpTablebyIndex(Index As Integer)
' 功 能： 1.给定一个Index索引,得到开始IPAddress,开始IPNumber, 结束IPAddress, 结束IPNumber,
' 国家字符串,地区字符串
' 参 数： Index 索引ID
' 返 回 值： Array 数组长度6. 0.开始IPAddress; 1.开始IPNumber; 2.结束IPAddress, 3.结束IPNumber;
' 4.国家字符串; 5.地区字符串
' 涉及的表： 无
Public Function GetIpTablebyIndex(Index)
Dim IndexWhyAr, AddrAr
'//IpTable["StartIP", "StartIPNumber", "EndIP", "EndIPNumber", "EndIPNumber", "Country", "Area"]
Dim IpTable(5)
IndexWhyAr = IndexWhy(Index, True, True)
IpTable(0) = NumberToIpAddress(IndexWhyAr(0))
IpTable(1) = IndexWhyAr(0)
IpTable(2) = NumberToIpAddress(IndexWhyAr(2))
IpTable(3) = IndexWhyAr(2)
AddrAr = GetAddr(IndexWhyAr(1))
IpTable(4) = BinaryToString(AddrAr(0))
IpTable(5) = BinaryToString(AddrAr(1))
GetIpTablebyIndex = IpTable
End Function
'////
' 过程名称： GetIpAddr()
' 过程原型： GetIpAddr(IPAddress As String)
' 功 能： 获取指定IPAddress国家地区
' 参 数： IPAddress IPAddress格式字符串
' 返 回 值： String 国家地区字符串
' 涉及的表： 无
Public Function GetIpAddr(IPAddress)
Dim i, j, IPNumber, IndexWhyAr, IpTable, ParQty, Paragraph
Dim ParIPStart, ParIPEnd, StartPar, EndPar
Paragraph = Int(Sqr(RecordCount)) ''分段
if Paragraph <= 0 then
Paragraph = 1
end if
ParQty = Int(RecordCount / Paragraph)
IPNumber = IPAddressToNumber(IPAddress)
For i = 0 to Paragraph - 1 ''跟据分段循环减小总循环次数
StartPar = i * ParQty
ParIPStart = IndexWhy(StartPar, False, False)(0)
if i = (Paragraph - 1) then
EndPar = RecordCount
ParIPEnd = IPAddressToNumber("255.255.255.255")
else
EndPar = (i + 1) * ParQty
ParIPEnd = IndexWhy(EndPar, False, False)(0)
end if
if (IPNumber >= ParIPStart) And (IPNumber <= ParIPEnd) then
For j = StartPar to ParIPEnd ''查找IPNumber所在范围
IndexNo = j
IndexWhyAr = IndexWhy(j, False, True)
if (IPNumber >= IndexWhyAr(0)) And (IPNumber <= IndexWhyAr(2)) then
IpTable = GetIpTablebyIndex(j)
GetIpAddr = Trim(IpTable(4) & " " & IpTable(5))
Exit For
End if
Next
Exit For
End if
Next
End Function
'///
End Class
%>
[[it] 本帖最后由 cen8c 于 2008-6-23 13:01 编辑 [/it]]
