JS
vbscript根据ip查询纯真数据库地址
JS
2025-12-23 03:38:32
3279
0
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,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()
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,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
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, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getaddrIP = Trim(Mid(strIPAddr, 1, 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()
%>本文由：xiaoshu168 作者：xiaoshu发表，转载请注明来源！