ASP calls pure IP database instances

<%
'================================================ =====
'Return IP information Disp_IPAddressData (IP, 0)
'================================================ =====
Function Look_Ip (IP)
Dim Wry, IPType, QQWryVersion, IpCounter
'Set the Class Object
Set Wry = New TQQWry
'Start searching and return the search result
'You can determine whether the IP address exists in the Database Based on the return value of QQWry (IP). If it does not exist, you can perform other operations.
'For example, if you have a self-built database for tracking, I will not detail it here.
IPType = Wry. QQWry (IP)
'Country: Country/region Field
'Localstr: province, city, and other information fields
Look_Ip = Wry. Country & "& Wry. LocalStr
''' Look _ Ip = Wry. Country &""
End Function
'================================================ =====
'Return IP information JS call
'================================================ =====
Function Disp_IPAddressData (IP, sType)
Dim Wry, IPType
Set Wry = New TQQWry
IPType = Wry. QQWry (IP)

Select Case sType
Case 1 Disp_IPAddressData = IP
Case 2 Disp_IPAddressData = Wry. 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 QQWry Information
'================================================ =====
Function WryInfo ()
Dim Wry, IPType, QQWry_tem (0), QQWry_tem1 (1)
'Set the Class Object
Set Wry = New TQQWry
IPType = Wry. QQWry ("255.255.255.254 ")
'Read database version information
QQWry_tem (0) = Wry. Country & "& Wry. LocalStr
'Number of read database IP addresses
QQWry_tem1 (1) = Wry. RecordCount + 1
WryInfo = QQWry_tem (0) & "& QQWry_tem1 (1)
End Function

Class TQQWry
'================================================ =====
'Variable name
'================================================ =====
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 pure IP address inventory path, change to your path
End Sub
'================================================ =====
'IP address 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 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
'================================================ =====
'Integer reverse IP Address
'================================================ =====
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) & "." & Cstr (p2) & "." & Cstr (p3) & "." & Cstr (p4)
End Function
'================================================ =====
'Obtain the starting IP address location
'================================================ =====
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
'================================================ =====
'Get the end IP address location
'================================================ =====
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
'================================================ =====
'Obtain region information, including country and province/City
'================================================ =====
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 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 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
'================================================ =====
'Get string Information
'================================================ =====
Private Function GetStr ()
Dim c
GetStr = ""
Do While (True)
C = AscB (Stream. Read (1 ))
If (c = 0) Then Exit Do

'If it is a double byte, the high byte is combined with the low byte to synthesize a character
If c & gt; 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
'================================================ =====
'Core function, execute IP search
'================================================ =====
Public Function QQWry (DotIP)
Dim IP, nRet
Dim RangB, RangE, RecNo

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 (LastStartIP-FirstStartIP)/7)
'No IP address is found in the database
If (RecordCount <= 1) Then
Country = "unknown"
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
'Not Found
NRet = 0
Else
'Normal
NRet = 3
End If
Call GetCountry (IP)

QQWry = nRet
End Function
'================================================ =====
'Class termination
'================================================ =====
Private Sub Class_Terminate
On ErrOr Resume Next
Stream. Close
If Err Then Err. Clear
Set Stream = Nothing
End Sub
End Class
%>