首先,是前人寫的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 %> 