利用QQ的IP查询数据库查询IP所在地ASP源码
<%
'' **********************************************************
'
' 利用QQ的IP查询数据库查询IP所在地ASP源码
'
' **********************************************************
' 【程序说明】
' 本程序是由Strongc的PHP程序改编而来，改写程序的目的主要在
' 于学习，请不要用于商业等用途，如有改变请通知原作者和我本人。
' 以下是原作者要求保留信息，大家使用本程序时，为了尊重作者，
' 请给予保留，谢谢！
' =====================================================
' QQwry.dat格式分析和查询IP位置的PHP程序
' By Strongc strongc.51.net/d2x/
'
' 转载时不要去掉我的名字和我的主页链接，谢谢！
'
' ======================================================
' 作者：东仔（欢迎交流，Email:liudong.163@163.com）
' 2003年8月
'
'【使用说明】
' 为了便于测试，就保留前端页面脚本模式，如有需要可以把本部分程序修
' 改为Server脚本就OK，具体请看内部注释。
Class TQQwry
Dim Country,LocalStr
Private StartIP,EndIP,CountryFlag
Private FirstStartIp,LastStartIp,EndIpOff
Private Stream,QQwryFile
Private Sub Class_Initialize
Country=""
LocalStr=""
StartIP=0
EndIP=0
CountryFlag=0 '标识 Country位置
' 0x01,随后3字节为Country偏移,没有LocalStr
' 0x02,随后3字节为Country偏移，接着是LocalStr
' 其他,Country,LocalStr,LocalStr有类似的压缩。可能多重引用。
FirstStartIp=0
LastStartIp=0
EndIpOff=0
QQwryFile="QQwry.dat" 'QQ IP库路径，请手动设置！！！
End Sub
function IpToInt(IP)
if trim(IP)="" then
IpToInt=0
exit function
end if
IpArray=Split(IP,".",-1)
if UBound(IpArray)<3 then
IpToInt=IpToInt(IP&".0")
exit function
end if
for i=0 to 3
if not IsNumeric(IpArray(i)) then IpArray(i)=0
if CInt(IpArray(i))<0 then IpArray(i)=Abs(CInt(IpArray(i)))
if CInt(IpArray(i))>255 then IpArray(i)=255
next
IpToInt=(CInt(IpArray(0))*256*256*256) + (CInt(IpArray(1))*256*256) + (CInt(IpArray(2))*256) + CInt(IpArray(3))
End function
function IntToIp(Intvalue)
p4=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p4)/256
p3=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p3)/256
p2=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p2)/256
p1=Intvalue
IntToIp=Cstr(p1)&"."&Cstr(p2)&"."&Cstr(p3)&"."&Cstr(p4)
end function
Private function getStartIp(RecNo)
offset = FirstStartIp + RecNo * 7
Stream.Position = offset
buf = Stream.Read(7)
EndIpOff = AscB(midb(buf,5,1)) + (AscB(midb(buf,6,1))*256) + (AscB(midb(buf,7,1))* 256*256)
StartIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
getStartIp=StartIp
end function
Private function getEndIp()
Stream.Position = EndIpOff
buf = Stream.Read(5)
EndIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
CountryFlag = AscB(midb(buf,5,1))
getEndIp=EndIp
end function
Private sub getCountry()
if (CountryFlag=1 or CountryFlag=2) then
Country = getFlagStr (EndIpOff+4)
if CountryFlag=1 then
LocalStr=""
else
LocalStr=getFlagStr (EndIpOff+8)
end if
else
Country = getFlagStr(EndIpOff+4)
LocalStr = getFlagStr (Stream.Position)
end if
end sub
Private function getFlagStr(offset)
flag = 0
do while (true)
Stream.Position=offset
flag = AscB(Stream.Read(1))
if(flag = 1 or flag = 2 ) then
buf = Stream.Read(3)
if (flag = 2 ) then
CountryFlag = 2
EndIpOff = offset - 4
end if
offset = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))* 256*256)
else
exit do
end if
loop
if (offset < 12 ) then
getFlagStr=""
else
Stream.Position=offset
getFlagStr=getStr()
end if
end function
Private function getStr()
getStr=""
do while (true)
c=AscB(Stream.Read(1))
if (c=0) then exit do
'如果是双字节，就进行高字节在结合低字节合成一个字符
If c > 127 Then
If Stream.EOS then Exit do
getStr=getStr&Chr(AscW(ChrB(AscB(Stream.Read(1)))&ChrB(C)))
Else
getStr=getStr&Chr(c)
End If
loop
end function
Public function qqwry(dotip)
dim nRet
ip = IpToInt (dotip)
'判断是否属于特殊IP
if ip>=IpToInt("127.0.0.0") and ip<=IpToInt("127.255.255.255") then
Country="本机内部环回地址"
LocalStr=""
nRet=1
exit function
elseif (ip>=IpToInt("0.0.0.0") and ip<=IpToInt("2.255.255.255")) _
or (ip>=IpToInt("64.0.0.0") and ip<=IpToInt("126.255.255.255")) _
or (ip>=IpToInt("58.0.0.0") and ip<=IpToInt("60.255.255.255")) then
Country="网络保留地址"
LocalStr=""
nRet=0
exit function
end if
set Stream=CreateObject("Adodb.Stream")
Stream.mode=3
Stream.type=1
Stream.open
Stream.LoadFromFile QQwryFile
Stream.Position=0
buf = Stream.Read(8)
FirstStartIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
LastStartIp = AscB(midb(buf,5,1)) + (AscB(midb(buf,6,1))*256) + (AscB(midb(buf,7,1))*256*256) + (AscB(midb(buf,8,1))*256*256*256)
RecordCount= Int( (LastStartIp - FirstStartIp)/7)
if (RecordCount <=1) then
Country = "FileDataError"
qqwry=2
exit function
end if
RangB= 0
RangE= RecordCount
do while (RangB < RangE-1)
RecNo= Int((RangB + RangE)/2)
Call getStartIp (RecNo)
if (ip=StartIp) then
RangB = RecNo
exit do
end if
if (ip > StartIp) then
RangB= RecNo
else
RangE= RecNo
end if
loop
Call getStartIp (RangB)
Call getEndIp()
if((StartIp<=ip) and ( EndIp >=ip)) then
nRet = 0
call getCountry()
if ip>=IpToInt("10.84.102.0") and ip<=IpToInt("10.84.103.255") then
Country=Country&"或山东省"
LocalStr="荷泽市(山东169电信用户)"
elseif ip>=IpToInt("10.150.5.92") and ip<=IpToInt("10.150.5.92") then
Country=Country&"或江苏省"
LocalStr="常州市"
elseif ip>=IpToInt("10.0.0.0") and ip<=IpToInt("10.255.255.255") then
Country=Country&"或未知"
LocalStr=""
end if
else
nRet=3
Country = "未知"
LocalStr = ""
end if
qqwry=nRet
end function
Private Sub Class_Terminate
On Error Resume Next
Stream.close
if Err.number<>0 then Err.Clear
set Stream=nothing
End Sub
end class
'返回IP信息
function ip2location (ip)
set wry =new TQQwry
nRet = wry.qqwry(ip)
'可以利用nRet做一些事情，我是让他自动记录未知IP到一个表,代码就不写了。
ip2location=wry.Country&wry.LocalStr
end function
'这是一个前端过程，改为ASP应注意修改！
IP=request("Ipvalue")
t1=Timer*1000
response.write "该IP属于："&ip2location(IP)&"IP（耗时："&(Timer*1000-t1)&"ms）"
%>
<center>
<table border="5" cellPadding=5 width="400">
<tr>
<td>
<pre style="line-height:120%">
**********************************************************
<h4 align="center">利用QQ的IP查询数据库查询IP所在地ASP源码</h4>
**********************************************************
【程序说明】
本程序是由Strongc的PHP程序改编而来，改写程序的目的主要在
于学习，请不要用于商业等用途，如有改变请通知原作者和我本人。
以下是原作者要求保留信息，大家使用本程序时，为了尊重作者，
请给予保留，谢谢！
<span style="color:#568B6F">
<a href="http://www.e99e.com/cgi-bin/topic.cgi?forum=27&topic=301&show=75" target="_blank" title="参看分析">QQwry.dat格式分析和查询IP位置的PHP程序</a>
By Strongc <a href="http://strongc.51.net/d2x/" target="_blank">http://strongc.51.net/d2x/</a>
转载时不要去掉我的名字和我的主页链接，谢谢！
</span>
作者：<a href="mailto:liudong.963@163.com">东仔</a>
2003年8月</pre></td>
</tr>
</table>
<br><br><form method="post" action="ip.asp">
<input type="text" value="127.0.0.1" name="Ipvalue">
<input type="submit" value="查询" >
<input type="reset" value="Reset">
</form>
</center>
<%
'' **********************************************************
'
' 利用QQ的IP查询数据库查询IP所在地ASP源码
'
' **********************************************************
' 【程序说明】
' 本程序是由Strongc的PHP程序改编而来，改写程序的目的主要在
' 于学习，请不要用于商业等用途，如有改变请通知原作者和我本人。
' 以下是原作者要求保留信息，大家使用本程序时，为了尊重作者，
' 请给予保留，谢谢！
' =====================================================
' QQwry.dat格式分析和查询IP位置的PHP程序
' By Strongc strongc.51.net/d2x/
'
' 转载时不要去掉我的名字和我的主页链接，谢谢！
'
' ======================================================
' 作者：东仔（欢迎交流，Email:liudong.163@163.com）
' 2003年8月
'
'【使用说明】
' 为了便于测试，就保留前端页面脚本模式，如有需要可以把本部分程序修
' 改为Server脚本就OK，具体请看内部注释。
Class TQQwry
Dim Country,LocalStr
Private StartIP,EndIP,CountryFlag
Private FirstStartIp,LastStartIp,EndIpOff
Private Stream,QQwryFile
Private Sub Class_Initialize
Country=""
LocalStr=""
StartIP=0
EndIP=0
CountryFlag=0 '标识 Country位置
' 0x01,随后3字节为Country偏移,没有LocalStr
' 0x02,随后3字节为Country偏移，接着是LocalStr
' 其他,Country,LocalStr,LocalStr有类似的压缩。可能多重引用。
FirstStartIp=0
LastStartIp=0
EndIpOff=0
QQwryFile="QQwry.dat" 'QQ IP库路径，请手动设置！！！
End Sub
function IpToInt(IP)
if trim(IP)="" then
IpToInt=0
exit function
end if
IpArray=Split(IP,".",-1)
if UBound(IpArray)<3 then
IpToInt=IpToInt(IP&".0")
exit function
end if
for i=0 to 3
if not IsNumeric(IpArray(i)) then IpArray(i)=0
if CInt(IpArray(i))<0 then IpArray(i)=Abs(CInt(IpArray(i)))
if CInt(IpArray(i))>255 then IpArray(i)=255
next
IpToInt=(CInt(IpArray(0))*256*256*256) + (CInt(IpArray(1))*256*256) + (CInt(IpArray(2))*256) + CInt(IpArray(3))
End function
function IntToIp(Intvalue)
p4=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p4)/256
p3=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p3)/256
p2=Intvalue-Fix(Intvalue/256)*256
Intvalue=(Intvalue-p2)/256
p1=Intvalue
IntToIp=Cstr(p1)&"."&Cstr(p2)&"."&Cstr(p3)&"."&Cstr(p4)
end function
Private function getStartIp(RecNo)
offset = FirstStartIp + RecNo * 7
Stream.Position = offset
buf = Stream.Read(7)
EndIpOff = AscB(midb(buf,5,1)) + (AscB(midb(buf,6,1))*256) + (AscB(midb(buf,7,1))* 256*256)
StartIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
getStartIp=StartIp
end function
Private function getEndIp()
Stream.Position = EndIpOff
buf = Stream.Read(5)
EndIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
CountryFlag = AscB(midb(buf,5,1))
getEndIp=EndIp
end function
Private sub getCountry()
if (CountryFlag=1 or CountryFlag=2) then
Country = getFlagStr (EndIpOff+4)
if CountryFlag=1 then
LocalStr=""
else
LocalStr=getFlagStr (EndIpOff+8)
end if
else
Country = getFlagStr(EndIpOff+4)
LocalStr = getFlagStr (Stream.Position)
end if
end sub
Private function getFlagStr(offset)
flag = 0
do while (true)
Stream.Position=offset
flag = AscB(Stream.Read(1))
if(flag = 1 or flag = 2 ) then
buf = Stream.Read(3)
if (flag = 2 ) then
CountryFlag = 2
EndIpOff = offset - 4
end if
offset = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))* 256*256)
else
exit do
end if
loop
if (offset < 12 ) then
getFlagStr=""
else
Stream.Position=offset
getFlagStr=getStr()
end if
end function
Private function getStr()
getStr=""
do while (true)
c=AscB(Stream.Read(1))
if (c=0) then exit do
'如果是双字节，就进行高字节在结合低字节合成一个字符
If c > 127 Then
If Stream.EOS then Exit do
getStr=getStr&Chr(AscW(ChrB(AscB(Stream.Read(1)))&ChrB(C)))
Else
getStr=getStr&Chr(c)
End If
loop
end function
Public function qqwry(dotip)
dim nRet
ip = IpToInt (dotip)
'判断是否属于特殊IP
if ip>=IpToInt("127.0.0.0") and ip<=IpToInt("127.255.255.255") then
Country="本机内部环回地址"
LocalStr=""
nRet=1
exit function
elseif (ip>=IpToInt("0.0.0.0") and ip<=IpToInt("2.255.255.255")) _
or (ip>=IpToInt("64.0.0.0") and ip<=IpToInt("126.255.255.255")) _
or (ip>=IpToInt("58.0.0.0") and ip<=IpToInt("60.255.255.255")) then
Country="网络保留地址"
LocalStr=""
nRet=0
exit function
end if
set Stream=CreateObject("Adodb.Stream")
Stream.mode=3
Stream.type=1
Stream.open
Stream.LoadFromFile QQwryFile
Stream.Position=0
buf = Stream.Read(8)
FirstStartIp = AscB(midb(buf,1,1)) + (AscB(midb(buf,2,1))*256) + (AscB(midb(buf,3,1))*256*256) + (AscB(midb(buf,4,1))*256*256*256)
LastStartIp = AscB(midb(buf,5,1)) + (AscB(midb(buf,6,1))*256) + (AscB(midb(buf,7,1))*256*256) + (AscB(midb(buf,8,1))*256*256*256)
RecordCount= Int( (LastStartIp - FirstStartIp)/7)
if (RecordCount <=1) then
Country = "FileDataError"
qqwry=2
exit function
end if
RangB= 0
RangE= RecordCount
do while (RangB < RangE-1)
RecNo= Int((RangB + RangE)/2)
Call getStartIp (RecNo)
if (ip=StartIp) then
RangB = RecNo
exit do
end if
if (ip > StartIp) then
RangB= RecNo
else
RangE= RecNo
end if
loop
Call getStartIp (RangB)
Call getEndIp()
if((StartIp<=ip) and ( EndIp >=ip)) then
nRet = 0
call getCountry()
if ip>=IpToInt("10.84.102.0") and ip<=IpToInt("10.84.103.255") then
Country=Country&"或山东省"
LocalStr="荷泽市(山东169电信用户)"
elseif ip>=IpToInt("10.150.5.92") and ip<=IpToInt("10.150.5.92") then
Country=Country&"或江苏省"
LocalStr="常州市"
elseif ip>=IpToInt("10.0.0.0") and ip<=IpToInt("10.255.255.255") then
Country=Country&"或未知"
LocalStr=""
end if
else
nRet=3
Country = "未知"
LocalStr = ""
end if
qqwry=nRet
end function
Private Sub Class_Terminate
On Error Resume Next
Stream.close
if Err.number<>0 then Err.Clear
set Stream=nothing
End Sub
end class
'返回IP信息
function ip2location (ip)
set wry =new TQQwry
nRet = wry.qqwry(ip)
'可以利用nRet做一些事情，我是让他自动记录未知IP到一个表,代码就不写了。
ip2location=wry.Country&wry.LocalStr
end function
'这是一个前端过程，改为ASP应注意修改！
IP=request("Ipvalue")
t1=Timer*1000
response.write "该IP属于："&ip2location(IP)&"IP（耗时："&(Timer*1000-t1)&"ms）"
%>
<center>
<table border="5" cellPadding=5 width="400">
<tr>
<td>
<pre style="line-height:120%">
**********************************************************
<h4 align="center">利用QQ的IP查询数据库查询IP所在地ASP源码</h4>
**********************************************************
【程序说明】
本程序是由Strongc的PHP程序改编而来，改写程序的目的主要在
于学习，请不要用于商业等用途，如有改变请通知原作者和我本人。
以下是原作者要求保留信息，大家使用本程序时，为了尊重作者，
请给予保留，谢谢！
<span style="color:#568B6F">
<a href="http://www.e99e.com/cgi-bin/topic.cgi?forum=27&topic=301&show=75" target="_blank" title="参看分析">QQwry.dat格式分析和查询IP位置的PHP程序</a>
By Strongc <a href="http://strongc.51.net/d2x/" target="_blank">http://strongc.51.net/d2x/</a>
转载时不要去掉我的名字和我的主页链接，谢谢！
</span>
作者：<a href="mailto:liudong.963@163.com">东仔</a>
2003年8月</pre></td>
</tr>
</table>
<br><br><form method="post" action="ip.asp">
<input type="text" value="127.0.0.1" name="Ipvalue">
<input type="submit" value="查询" >
<input type="reset" value="Reset">
</form>
</center>
回复Comments
作者:
{commentrecontent}