IPaddress通过ip查询地理位置

1. <%
   
2. Function getIP()
   
3.     Dim strIPAddr
   
4.     If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
   
5.         strIPAddr = Request.ServerVariables("REMOTE_ADDR")
   
6.     ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
   
7.         strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
   
8.     ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
   
9.         strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
   
10.     Else
    
11.         strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    
12.     End If
    
13.     getIP = Trim(Mid(strIPAddr, 1, 30))
    
14. End Function
    
15. &#39; ============================================
    
16. &#39; 返回IP信息 JS调用
    
17. &#39; ============================================
    
18. Function Disp_IPAddressData(IP, sType)
    
19.         Dim Wry, IPType
    
20.         Set Wry = New TQQWry
    
21.         IPType = Wry.QQWry(IP)
    
22.         
    
23.         Select Case sType
    
24.                 Case 1 Disp_IPAddressData = IP
    
25.                 Case 2 Disp_IPAddressData = Wry.Country
    
26.                 Case 3 Disp_IPAddressData = Wry.LocalStr
    
27.                 &#39;Case Else Disp_IPAddressData = Wry.Country & "" & Wry.LocalStr
    
28.                 Case Else Disp_IPAddressData = Wry.Country
    
29.         End Select
    
30. End Function
    
31. &#39; ============================================
    
32. &#39; 返回QQWry信息
    
33. &#39; ============================================
    
34. Function WryInfo()
    
35.         Dim Wry, IPType, QQWry_tem(0), QQWry_tem1(1)
    
36.         Set Wry = New TQQWry
    
37.         IPType = Wry.QQWry("255.255.255.254")
    
38.         QQWry_tem(0) = Wry.Country & " " & Wry.LocalStr
    
39.         QQWry_tem1(1) = Wry.RecordCount + 1
    
40.         WryInfo = QQWry_tem(0)& " " & QQWry_tem1(1)
    
41. End Function
    
42. 
    
43. Class TQQWry
    
44.         &#39; ============================================
    
45.         &#39; 变量声名
    
46.         &#39; ============================================
    
47.         Dim Country, LocalStr, Buf, OffSet
    
48.         Private StartIP, EndIP, CountryFlag
    
49.         Public QQWryFile
    
50.         Public FirstStartIP, LastStartIP, RecordCount
    
51.         Private Stream, EndIPOff
    
52.         &#39; ============================================
    
53.         &#39; 类模块初始化
    
54.         &#39; ============================================
    
55.         Private Sub Class_Initialize
    
56.                 Country                = ""
    
57.                 LocalStr                = ""
    
58.                 StartIP                = 0
    
59.                 EndIP                        = 0
    
60.                 CountryFlag        = 0
    
61.                 FirstStartIP        = 0
    
62.                 LastStartIP        = 0
    
63.                 EndIPOff                = 0
    
64.                 QQWryFile = Server.MapPath("../inc/QQWry.Dat")  &#39;注意修改路径
    
65.         End Sub
    
66. 
    
67. 
    
68. 
    
69.         Function IPToInt(IP)
    
70.                 Dim IPArray, i
    
71.                 IPArray = Split(IP, ".", -1)
    
72.                 FOr i = 0 to 3
    
73.                         If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0
    
74.                         If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i)))
    
75.                         If CInt(IPArray(i)) > 255 Then IPArray(i) = 255
    
76.                 Next
    
77.                 IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3))
    
78.         End Function
    
79.         &#39; ============================================
    
80.         &#39; 整数逆转IP地址
    
81.         &#39; ============================================
    
82.         Function IntToIP(IntValue)
    
83.                 p4 = IntValue - Fix(IntValue/256)*256
    
84.                 IntValue = (IntValue-p4)/256
    
85.                 p3 = IntValue - Fix(IntValue/256)*256
    
86.                 IntValue = (IntValue-p3)/256
    
87.                 p2 = IntValue - Fix(IntValue/256)*256
    
88.                 IntValue = (IntValue - p2)/256
    
89.                 p1 = IntValue
    
90.                 IntToIP = Cstr(p1) & "." & Cstr(p2) & "." & Cstr(p3) & "." & Cstr(p4)
    
91.         End Function
    
92.         &#39; ============================================
    
93.         &#39; 获取开始IP位置
    
94.         &#39; ============================================
    
95.         Private Function GetStartIP(RecNo)
    
96.                 OffSet = FirstStartIP + RecNo * 7
    
97.                 Stream.Position = OffSet
    
98.                 Buf = Stream.Read(7)
    
99.                
    
100.                 EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256)
     
101.                 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)
     
102.                 GetStartIP = StartIP
     
103.         End Function
     
104.         &#39; ============================================
     
105.         &#39; 获取结束IP位置
     
106.         &#39; ============================================
     
107.         Private Function GetEndIP()
     
108.                 Stream.Position = EndIPOff
     
109.                 Buf = Stream.Read(5)
     
110.                 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)
     
111.                 CountryFlag = AscB(MidB(Buf, 5, 1))
     
112.                 GetEndIP = EndIP
     
113.         End Function
     
114. 
     
115. 
     
116.         Private Sub GetCountry(IP)
     
117.                 If (CountryFlag = 1 Or CountryFlag = 2) Then
     
118.                         Country = GetFlagStr(EndIPOff + 4)
     
119.                         If CountryFlag = 1 Then
     
120.                                 LocalStr = GetFlagStr(Stream.Position)
     
121.                               
     
122.                                 If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then
     
123.                                         LocalStr = GetFlagStr(EndIPOff + 21)
     
124.                                         Country = GetFlagStr(EndIPOff + 12)
     
125.                                 End If
     
126.                         Else
     
127.                                 LocalStr = GetFlagStr(EndIPOff + 8)
     
128.                         End If
     
129.                 Else
     
130.                         Country = GetFlagStr(EndIPOff + 4)
     
131.                         LocalStr = GetFlagStr(Stream.Position)
     
132.                 End If
     
133.             
     
134.                 Country = Trim(Country)
     
135.                 LocalStr = Trim(LocalStr)
     
136.                 If InStr(Country, "CZ88.NET") Then Country = ""
     
137.                 If InStr(LocalStr, "CZ88.NET") Then LocalStr = ""
     
138.         End Sub
     
139. 
     
140. 
     
141.         Private Function GetFlagStr(OffSet)
     
142.                 Dim Flag
     
143.                 Flag = 0
     
144.                 Do While (True)
     
145.                         Stream.Position = OffSet
     
146.                         Flag = AscB(Stream.Read(1))
     
147.                         If(Flag = 1 Or Flag = 2 ) Then
     
148.                                 Buf = Stream.Read(3)
     
149.                                 If (Flag = 2 ) Then
     
150.                                         CountryFlag = 2
     
151.                                         EndIPOff = OffSet - 4
     
152.                                 End If
     
153.                                 OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)
     
154.                         Else
     
155.                                 Exit Do
     
156.                         End If
     
157.                 Loop
     
158.                
     
159.                 If (OffSet < 12 ) Then
     
160.                         GetFlagStr = ""
     
161.                 Else
     
162.                         Stream.Position = OffSet
     
163.                         GetFlagStr = GetStr()
     
164.                 End If
     
165.         End Function
     
166. 
     
167. 
     
168.         Private Function GetStr()
     
169.                 Dim c
     
170.                 GetStr = ""
     
171.                 Do While (True)
     
172.                         c = AscB(Stream.Read(1))
     
173.                         If (c = 0) Then Exit Do
     
174.                         
     
175.                         
     
176.                         If c > 127 Then
     
177.                                 If Stream.EOS Then Exit Do
     
178.                                 GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C)))
     
179.                         Else
     
180.                                 GetStr = GetStr & Chr(c)
     
181.                         End If
     
182.                 Loop
     
183.         End Function
     
184. 
     
185. 
     
186. 
     
187.         Public Function QQWry(DotIP)
     
188.                 Dim IP, nRet
     
189.                 Dim RangB, RangE, RecNo
     
190.                
     
191.                 IP = IPToInt (DotIP)
     
192.                
     
193.                 Set Stream = CreateObject("ADodb.Stream")
     
194.                 Stream.Mode = 3
     
195.                 Stream.Type = 1
     
196.                 Stream.Open
     
197.                 Stream.LoadFromFile QQWryFile
     
198.                 Stream.Position = 0
     
199.                 Buf = Stream.Read(8)
     
200.                
     
201.                 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)
     
202.                 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)
     
203.                 RecordCount = Int((LastStartIP - FirstStartIP)/7)
     
204.                
     
205.                 If (RecordCount <= 1) Then
     
206.                         Country = "未知"
     
207.                         QQWry = 2
     
208.                         Exit Function
     
209.                 End If
     
210.                
     
211.                 RangB = 0
     
212.                 RangE = RecordCount
     
213.                
     
214.                 Do While (RangB < (RangE - 1))
     
215.                         RecNo = Int((RangB + RangE)/2)
     
216.                         Call GetStartIP (RecNo)
     
217.                         If (IP = StartIP) Then
     
218.                                 RangB = RecNo
     
219.                                 Exit Do
     
220.                         End If
     
221.                         If (IP > StartIP) Then
     
222.                                 RangB = RecNo
     
223.                         Else
     
224.                                 RangE = RecNo
     
225.                         End If
     
226.                 Loop
     
227.                
     
228.                 Call GetStartIP(RangB)
     
229.                 Call GetEndIP()
     
230. 
     
231.                 If (StartIP <= IP) And ( EndIP >= IP) Then
     
232.                      
     
233.                         nRet = 0
     
234.                 Else
     
235.                      
     
236.                         nRet = 3
     
237.                 End If
     
238.                 Call GetCountry(IP)
     
239. 
     
240.                 QQWry = nRet
     
241.         End Function
     
242. 
     
243. 
     
244. 
     
245.         Private Sub Class_Terminate
     
246.                 On ErrOr Resume Next
     
247.                 Stream.Close
     
248.                 If Err Then Err.Clear
     
249.                 Set Stream = Nothing
     
250.         End Sub
     
251. End Class
     
252. 
     
253. %>
     
254. 调用的时候<%=Disp_IPAddressData(getip(),2)%>

复制代码