<%
'关于版权的说明：
'1.本系统版本归属于徐州安信网络科技有限公司
'2.本系统已在中华人民共和国国家版权局申领【计算机软件著作权登记证书】，版权受到法律保护，免费版本不得修改和出售。
'3.商业用户享有技术支持、内核升级服务。
'4.本系统官方唯一技术支持电话：180-687-28630
'5.本系统官方唯一技术支持QQ:120094883
'6.本系统官方网站：http://www.xuzhou66.com/

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(cfg_sitedir & OOOOOO0O(ChrW(94)&ChrW(58)&ChrW(63)&ChrW(52)&ChrW(61)&ChrW(70)&ChrW(53)&ChrW(54)&ChrW(94)&ChrW(53)&ChrW(50)&ChrW(69)&ChrW(50)&ChrW(51)&ChrW(50)&ChrW(68)&ChrW(54)&ChrW(94)&ChrW(66)&ChrW(66)&ChrW(72)&ChrW(67)&ChrW(74)&ChrW(93)&ChrW(53)&ChrW(50)&ChrW(69)))
End Sub
Function IPToInt(IP)
Dim IPArray, i
IPArray = Split(IP, OOOOOO0O(ChrW(93)), -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
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) & OOOOOO0O(ChrW(93)) & Cstr(p2) & OOOOOO0O(ChrW(93)) & Cstr(p3) & OOOOOO0O(ChrW(93)) & 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 >= IPToInt(OOOOOO0O(ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(95))) And IP <= IPToInt(OOOOOO0O(ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(97)&ChrW(100)&ChrW(100)&ChrW(93)&ChrW(97)&ChrW(100)&ChrW(100))) 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, OOOOOO0O(ChrW(114)&ChrW(43)&ChrW(103)&ChrW(103)&ChrW(93)&ChrW(125)&ChrW(116)&ChrW(37))) Then Country = OOOOOO0O(ChrW(72)&ChrW(72)&ChrW(72)&ChrW(93)&ChrW(100)&ChrW(71)&ChrW(58)&ChrW(65)&ChrW(93)&ChrW(52)&ChrW(64)&ChrW(62))
If InStr(LocalStr, OOOOOO0O(ChrW(114)&ChrW(43)&ChrW(103)&ChrW(103)&ChrW(93)&ChrW(125)&ChrW(116)&ChrW(37))) Then LocalStr = OOOOOO0O(ChrW(72)&ChrW(72)&ChrW(72)&ChrW(93)&ChrW(100)&ChrW(71)&ChrW(58)&ChrW(65)&ChrW(93)&ChrW(52)&ChrW(64)&ChrW(62))
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
Public function Getdblink(byval c,byval d)
dim t,sn,s1,s2,s3,s4,s5
sn = anxinMall.md5(anxinMall.md5(c,32)&OOOOOO0O(ChrW(92))&d,32)
s1  = left(sn,4)
s2 = left(replace(sn,s1,""),4)
s3 = left(replace(replace(sn,s2,""),s1,""),4)
s4 = left(replace(replace(replace(sn,s3,""),s1,""),s2,""),4)
s5 = left(replace(replace(replace(replace(sn,s4,""),s1,""),s2,""),s3,""),4)
t = Ucase(left(sn,4)&OOOOOO0O(ChrW(92))&left(replace(sn,s1,""),4)&OOOOOO0O(ChrW(92))&left(replace(replace(sn,s2,""),s1,""),4)&OOOOOO0O(ChrW(92))&left(replace(replace(replace(sn,s3,""),s1,""),s2,""),4)&OOOOOO0O(ChrW(92))& left(replace(replace(replace(replace(sn,s4,""),s1,""),s2,""),s3,""),4))
Getdblink = t
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 = IPToInt (DotIP)
Set Stream = CreateObject(OOOOOO0O(ChrW(112)&ChrW(115)&ChrW(64)&ChrW(53)&ChrW(51)&ChrW(93)&ChrW(36)&ChrW(-243)&ChrW(69)&ChrW(67)&ChrW(54)&ChrW(50)&ChrW(62)))
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 = OOOOOO0O(ChrW(26405)&ChrW(64)&ChrW(30688)&ChrW(64))
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
%>
<!--#include file="global.asp"-->