<%
'=======================================
'Return IP information Disp_ipaddressData (IP, 0)
'=======================================
Function look_ip (ip)
Dim ...
'Setting class object
Set station = new tqqwry
'Start search and return the search results
'You can determine whether the IP address exists in the database based on the QQwry (IP) return value, and some other operations can be performed if there is no existence
'For example, you built a database as a hunt, I will not explain in detail here
Iptype = Wry.qqwry (ip)
'Country: National and Region Fields
'LocalStr: Provincial and municipal and other information fields
Look_ip = Wry.Country & & Wry.localStr
'' 'LOOK_IP = WRY.COUNTRY &
End function
'=======================================
'Return to IP information js call
'=======================================
Function disp_ipaddressdata (IP, style)
Dimover, iltype
Set station = new tqqwry
Iptype = Wry.qqwry (ip)
Select case style
Case 1 Disp_ipaddressData = IP
Case 2 disp_ipaddressData = station.country
Case 3 Disp_ipaddressData = WRY.LOCALSTR
'Case Else Disp_ipaddressData = Wry.Country & & Wry.localStr
Case Else Disp_ipaddressData = Wry.country
End select
End function
'=======================================
'Return to QQwry Information
'=======================================
Function Wryinfo ()
Dimover, iptype, QQwry_tem (0), QQwry_tem1 (1)
'Setting class object
Set station = new tqqwry
Iptype = Wry.qqwry (255.255.255.254)
'Read the database version information
QQwry_tem (0) = Wry.Country & & Wry.localStr
'Read the number of database IP addresses
Qqwry_tem1 (1) = Wry.recordcount + 1
Wryinfo = QQwry_tem (0) & qqwry_tem1 (1)
End function
Class tqqwry
'=======================================
'Variable reputation
'=======================================
Dim Country, LocalStr, BUF, Offset
Private Startip, Endip, Countryflag
Public QQwryfile
Public firstStartip, LastStartip, RecordCount
Private Stream, Endipoff
'=======================================
'Class module initialization
'=======================================
Private sub class_initialize
Country =
LOCALSTR =
Startip = 0
Endip = 0
Countryflag = 0
Firststartip = 0
LastStartip = 0
Endipoff = 0
Qqwryfile = server.mappath (/data/qqwry.dat) 'QQ innocent IP inventory path, to change to your path
End sub
'=======================================
'IP address convert to integer
'=======================================
Function iPtoint (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 thatn iParray (i) = ABS (cint (iparray (i)))
If cint (iparray (i))> 255 that iparray (i) = 255
Next
Iptoint = (cint (iparray (0))*256*256*256) + (cint (iParray (1))*256*256) + (cint (iparray (2))*256) + cint (iparray (3) Cure
End function
'=======================================
'Our integer reversing IP address
'=======================================
Function Inttoip (Intvalue)
p4 = int Value -Fix (Intvalue/256)*256
Intvalue = (INTVALUE-P4)/256
p3 = int Value -FIX (Intvalue/256)*256
Intvalue = (INTVALUE-P3)/256
p2 = int Value -FIX (Intvalue/256)*256
Intvalue = (INTVALUE -P2)/256
p1 = int Value
Intoip = cstr (P1) &. & CSTR (P2) &. & CSTR (P3) &. & CSTR (P4)
End function
'=======================================
'Get the start IP location
'=======================================
Private functions 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
'=======================================
'Get the end IP position
'=======================================
Private function geetedip ()
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
'=======================================
'Get regional information, including the country and the provincial and cities
'=======================================
Private sub getCountry (IP)
If (countryflag = 1 or countryflag = 2) then
Country = getFlagstr (endipoff + 4)
If countryflag = 1 then
Localstr = getflagstr (stream.position)
'The following is used to obtain the database version information
If ip> = iptoint (255.255.255.0) and ip <= iptoint (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
'Filter the useless information in the database
Country = trim (country)
LocalStr = TRIM (LOCALSTR)
If Instr (Country, CZ88.NET) then Country =
If Instr (LOCALSTR, CZ88.NET) then LocalStr =
End sub
'=======================================
'Get the IP address identifier
'=======================================
Private function getflagstr (offset)
Dim Flag
FLAG = 0
Do whole (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
'=======================================
'Get the string information
'=======================================
Private function getstr ()
Dim C
Getstr =
Do whole (true)
c = ascb (stream.read (1))
If (c = 0) then exit do
'If it is a two -byte, a high byte is combined in combination with a low byte synthesis of a character
If c> 127 then
If stream.eos the exit do
Getstr = GetStr & Chr (ASCW (chrb (ascb (stream.read (1))) & chrb (c)
Else
GetStr = Getstr & CHR (C)
End if
Loop
End function
'=======================================
'Core function, execute IP search
'=======================================
Public function QQwry (dotip)
Dim ip, nret
Dim Rangb, Range, Range, Range
Ip = iptoint (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
'Can't find any IP address in the database
If (recordcount <= 1) then
Country = unknown
QQwry = 2
Exit function
End if
Rangb = 0
Range = recordcount
Do why (Rangb <(Range -1))
RANGB + RANGE/2)
Call GetStartip (RECNO)
If (IP = Startip) then
Rangb = recino
Exit do
End if
If (ip> startip) then
Rangb = recino
Else
Range = recno
End if
Loop
Call getstartip (Rangb)
Call Getendip ()
If (Startip <= ip) and (Endip> = IP) then
'No found
nret = 0
Else
' normal
nret = 3
End if
Call getcountry (ip)
QQwry = nret
End function
'=======================================
'Class end
'=======================================
Private sub class_terminate
On error resume next
Stream.close
If err then err.clear
Set stream = nothing
End sub
End class
%>