vbscript根据ip查询纯真数据库的地址
纯真数据库下载地址http://www.cz88.net/
<%@Language="vbscript" Codepage="936"%> <meta http-equiv="Content-Type" content="text/html; charset=gb2312" > <% 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") <!--QQWryFile="C:\Program Files (x86)\cz88.net\ip\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,2,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))*256*256*256) CountryFlag=AscB(MidB(Buf,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))*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() Dim IP,nRet,DotIP Dim RangB,RangE,RecNo <!-- getaddrIP 自动获取客户端ip--> DotIP = getaddrIP() If DotIP= "127.0.0.1" or DotIP= "::1" then DotIP ="192.168.0.1" End If 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))*256*256*256) LastStartIP=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 Private Function getaddrIP() 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) Else strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") End If getaddrIP = Trim(Mid(strIPAddr, 30)) End Function End Class Function Look_Ip() Dim Wry, IPType, QQWryVersion, IpCounter Set Wry = New TQQWry On Error Resume Next IPType = Wry.QQWry() Look_Ip = Wry.Country & " - " & Wry.LocalStr End Function response.write Look_Ip() %>
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。