发布网友 发布时间:2022-04-23 23:58
共4个回答
热心网友 时间:2022-05-03 06:01
首先,是前人写的ASP查询纯真IP的类,请保存为cz.asp
需要一个ip数据库,把cz.asp,serach.asp和cz.dat数据库放在一起。
<%
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("cz.dat")
End Sub
Public Sub SetPath(p)
QQWryFile = Server.MapPath(p)
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 = "IALVIN.CN"
If InStr(LocalStr,"CZ88.net") Then LocalStr = "IALVIN.CN"
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
Function Look_Ip(path,IP)
Dim Wry, IPType, QQWryVersion, IpCounter
Set Wry = New TQQWry
Wry.SetPath path
On Error Resume Next
IPType = Wry.QQWry(IP)
Look_Ip = Wry.Country & " - " & Wry.LocalStr
If Err Then
Err.Clear
Look_Ip = "查询出错"
End If
End Function
%>
下面是查询代码,请保存为search.asp
<!--#include file="cz.asp" -->
<%
Dim IP
ip=request.querystring("ip")
if trim(ip)="" then
IP=Request.ServerVariables("REMOTE_ADDR")
elseif ubound(split(trim(ip),"."))<>3 then
IP=Request.ServerVariables("REMOTE_ADDR") 'ip地址
end if
IPAdd=Look_Ip("cz.dat",IP) '这里注意,数据库文件名是cz.dat
response.write IPAdd
%>
热心网友 时间:2022-05-03 07:19
'给你一个获得IP的函数,如果想得到地理位置,需要一个IP数据库,类似QQ显IP的数据库,暂时没有。
Function GetIP()
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
GetIP = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
GetIP = 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
GetIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
GetIP = Trim(Mid(GetIP, 1, 30))
End Function
热心网友 时间:2022-05-03 08:54
这种显示你需要有ip地址与地理位置对应的地址库才可以。
热心网友 时间:2022-05-03 10:45
什么啊