纯真IP数据库在ASP。NET网站中如何用?C#

纯真IP数据库在ASP。NET网站中如何用?C#,第1张

应为在远程服务器上,没有 F:\商务网站设计\QQip\ip\QQWry.Dat

你需要把它改写成 Server.MapPath("/ip/QQWry.Dat")

然后把 QQWry.Dat 文件放在网站的ip 目录下

不推荐调用第三方接口,不稳定,而且查询效率太低。

几乎所有的网站程序显示IP地理位置都是通过本地的IP地址数据库实现的,而使用的IP地址数据库多数是纯真网络的,你可以在http://update.cz88.net/soft/setup.zip下载到

下面的函数是用来调用纯真IP数据库查询IP归属地的

首先,将你下载的setup.zip解压缩,执行解压出来的setup.exe安装

安装后启动“纯真IP地址数据库”,可以查看到IP地址的更新时间,通过点击“在线升级”可以更新IP数据库(因为有时候一些IP的分配会改变,所以IP数据库长年不更新会不准确)

确保你的IP数据是最新的后,找到“纯真IP地址数据库”的安装文件夹(既然楼主是做程序开发的,应该会找程序的安装目录,不多解释,不明白可以追问),将安装文件夹下的qqwry.dat拷贝到你的网站目录,这个就是IP数据库了。

下面的函数是查询qqwry.dat用的,注意Server.MapPath("QQWry.dat")处的QQWry.dat路径要正确。

调用方法:

GetIpInfo("IP地址")

如:

IPLocation=GetIpInfo("192.168.1.1")

response.write IPLocation

<%

'=================获取地理位置函数

Function GetIpInfo(IP)

Dim Wry,IPType

Set Wry=New TQQWry

IPType=Wry.QQWry(IP)

GetIpInfo=Wry.Country&Wry.LocalStr

 Set Wry = Nothing

End Function

'=================

'=================IP地理检索类对象

Class TQQWry

Dim Country,LocalStr,Buf,OffSet

Private StartIP,EndIP,CountryFlag

Public FirstStartIP,LastStartIP,RecordCount,QQWryFile

Private Stream,EndIPOff

Private Sub Class_Initialize

Country=""

LocalStr=""

StartIP=0

EndIP=0

CountryFlag=0 

FirstStartIP=0 

LastStartIP=0 

EndIPOff=0 

QQWryFile=Server.MapPath("QQWry.dat")

End Sub

Function IP2Int(IP)

Dim IPArray,i

IPArray=Split(IP,".",-1)

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

IP2Int=(CInt(IPArray(0))*256*256*256)+(CInt(IPArray(1))*256*256)+(CInt(IPArray(2))*256)+CInt(IPArray(3))'-1

End Function

Function Int2IP(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

Int2IP=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(IP)

If (CountryFlag=1 Or CountryFlag=2) Then

Country=GetFlagStr(EndIPOff+4)

If CountryFlag=1 Then

LocalStr=GetFlagStr(Stream.Position)

If IP>= IP2Int("255.255.255.0") And IP<=IP2Int("255.255.255.255") Then

LocalStr=GetFlagStr(EndIPOff+21)

Country=GetFlagStr(EndIPOff+12)

End If

Else

LocalStr=GetFlagStr(EndIPOff+8)

End If

Else

Country=GetFlagStr(EndIPOff+4)

LocalStr=GetFlagStr(Stream.Position)

End If

Country=Trim(Country)

LocalStr=Trim(LocalStr)

If InStr(Country,"CZ88.NET") Then Country=""

If InStr(LocalStr,"CZ88.NET") Then LocalStr=""

End Sub

Private Function GetFlagStr(OffSet)

Dim Flag

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() 

Dim c

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 IP,nRet

Dim RangB,RangE,RecNo

IP=IP2Int(DotIP)

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="Unknow"

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

Else

nRet=3

End If

Call GetCountry(IP)

QQWry=nRet

End Function

Private Sub Class_Terminate()

On ErrOr Resume Next

Stream.Close

If Err Then Err.Clear

Set Stream=Nothing

End Sub

End Class

'=================

%>

希望能够解决您的问题,如有进一步疑问欢迎追加。

刚回答了一个问题,与这个相似..

是采用QQ的ip数据库.

1.将QQ安装目录下的QQwry.dat文件复制到asp文件夹下

2.建立一个asp文件,如文件名ip.asp.代码内容为:

<%

'文件名:ip.asp 与QQwry.dat放在一个文件夹下面

'使用:在要用到的查询ip的asp页面中最前面加入<!--#include file = "ip.asp"-->

'然后可以用address(getIP())获得请求的地理位置

'=========================================================

' IP物理定位搜索类 Version 3.0.0

' QQWry.DAT 利用程序 修改自互联网流传代码

' 本类在ASP环境中使用纯真版QQWry.dat通过完美测试

' 如果您的服务器环境不支持ADodb.Stream,将无法使用此程序

' 推荐使用纯真数据库,更新也方便

' ========================================================

' ============================================

' 返回IP信息

' 如address("127.0.0.1")

' 返回值为:"本机地址 CZ88.NET"

' ============================================

Function address(sip)

Dim Wry, IPType

Set Wry = New TQQWry

IPType = Wry.QQWry(sip)

address=""&Wry.Country &" " &Wry.LocalStr &""

End Function

'获得请求的实际IP地址

Function getIP()

Dim strIPAddr

If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") >0 Then

strIPAddr = Request.ServerVariables("REMOTE_ADDR")

ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") >0 Then

strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)

ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "") >0 Then

strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "")-1)

Else

strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")

End If

getIP = Trim(Mid(strIPAddr, 1, 30))

End Function

Function Look_Ip(IP)

Dim Wry, IPType, QQWryVersion, IpCounter

' 设置类对象

Set Wry = New TQQWry

' 开始搜索,并返回搜索结果

' 您可以根据 QQWry(IP) 返回值来判断该IP地址在数据库中是否存在,如果不存在可以执行其他的一些 *** 作

' 比如您自建一个数据库作为追捕等,这里我就不详细说明了

IPType = Wry.QQWry(IP)

' Country:国家地区字段

' LocalStr:省市及其他信息字段

Look_Ip = Wry.Country &" " &Wry.LocalStr

End Function

' ============================================

' 返回IP信息 JS调用

' ============================================

Function GetIpInfoAv(IP, sType)

Dim Wry, IPType

Set Wry = New TQQWry

IPType = Wry.QQWry(IP)

Select Case sType

Case 1 GetIpInfoAv = "document.write(""" &IP &""")"

Case 2 GetIpInfoAv = "document.write(""" &Wry.Country &""")"

Case 3 GetIpInfoAv = "document.write(""" &Wry.LocalStr &""")"

Case Else GetIpInfoAv = "document.write(""您来自:" &IP &" 所在区域:" &Wry.Country &" " &Wry.LocalStr &""")"

End Select

End Function

' ============================================

' 返回QQWry信息

' ============================================

Function WryInfo()

Dim Wry, IPType, QQWry(1)

' 设置类对象

Set Wry = New TQQWry

IPType = Wry.QQWry("255.255.255.255")

' 读取数据库版本信息

QQWry(0) = Wry.Country &" " &Wry.LocalStr

' 读取数据库IP地址数目

QQWry(1) = Wry.RecordCount + 1

WryInfo = QQWry

End Function

' ============================================

' 爱雪儿IP物理定位搜索类

' ============================================

Class TQQWry

' ============================================

' 变量声名

' ============================================

Dim Country, LocalStr, Buf, OffSet

Private StartIP, EndIP, CountryFlag

Public QQWryFile

Public FirstStartIP, LastStartIP, RecordCount

Private Stream, EndIPOff

' ============================================

' 类模块初始化

' ============================================

Private Sub Class_Initialize

Country = ""

LocalStr = ""

StartIP = 0

EndIP = 0

CountryFlag = 0

FirstStartIP = 0

LastStartIP = 0

EndIPOff = 0

QQWryFile = Server.MapPath("QQWry.dat") 'QQ IP库路径,要转换成物理路径

End Sub

' ============================================

' IP地址转换成整数

' ============================================

Function IPToInt(IP)

Dim IPArray, i

IPArray = Split(IP, ".", -1)

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

' ============================================

' 整数逆转IP地址

' ============================================

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

' ============================================

' 获取开始IP位置

' ============================================

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

' ============================================

' 获取结束IP位置

' ============================================

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(IP)

If (CountryFlag = 1 Or CountryFlag = 2) Then

Country = GetFlagStr(EndIPOff + 4)

If CountryFlag = 1 Then

LocalStr = GetFlagStr(Stream.Position)

' 以下用来获取数据库版本信息

If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then

LocalStr = GetFlagStr(EndIPOff + 21)

Country = GetFlagStr(EndIPOff + 12)

End If

Else

LocalStr = GetFlagStr(EndIPOff + 8)

End If

Else

Country = GetFlagStr(EndIPOff + 4)

LocalStr = GetFlagStr(Stream.Position)

End If

' 过滤数据库中的无用信息

Country = Trim(Country)

LocalStr = Trim(LocalStr)

If InStr(Country, "CZ88.NET") Then Country = "114XP.CN"

If InStr(LocalStr, "CZ88.NET") Then LocalStr = "114XP.CN"

End Sub

' ============================================

' 获取IP地址标识符

' ============================================

Private Function GetFlagStr(OffSet)

Dim Flag

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()

Dim c

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

' ============================================

' 核心函数,执行IP搜索

' ============================================

Public Function QQWry(DotIP)

Dim IP, nRet

Dim RangB, RangE, RecNo

IP = IPToInt (DotIP)

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)

' 在数据库中找不到任何IP地址

If (RecordCount <= 1) Then

Country = "未知"

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

Else

' 正常

nRet = 3

End If

Call GetCountry(IP)

QQWry = nRet

End Function

' ============================================

' 类终结

' ============================================

Private Sub Class_Terminate

On ErrOr Resume Next

Stream.Close

If Err Then Err.Clear

Set Stream = Nothing

End Sub

End Class

%>

3.要查询ip的asp页面内加入:

<!--#include file = "ip.asp"-->

<%

dim ip,ipx

ip=getIP()

ipx=address(ip)

%>

详情: http://zhidao.baidu.com/question/63283862.html

要是回答的内容有问题,或认为不妥,请发送百度消息给我,消息内容加上本页网址哦。。

·


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/sjk/6781469.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-03-28
下一篇 2023-03-28

发表评论

登录后才能评论

评论列表(0条)

保存