2004/12/10 | 利用QQ的IP查询数据库查询IP所在地ASP源码『转帖』
类别(技术) | 评论(0) | 阅读(209) | 发表于 16:03
利用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>

0

评论Comments

日志分类
首页[1019]
技术[317]
English[3]
下载[59]
IT业界[203]
发现[47]
音乐[17]
网文[322]
blog应用[36]
BLOG参考[15]