技术文章 订阅所有【技术文章】的日志

Asp读取调用纯真IP数据库

作者:admin 日期:2013-09-23

字体大小: 小 中 大
ASP/Visual Basic代码
  1. <%   
  2. '文件名:ip.asp 与QQwry.dat放在一个文件夹下面   
  3. '使用:在要用到的查询ip的asp页面中最前面加入<!--#include file = "ip.asp"-->   
  4. '然后可以用address(getIP())获得请求的地理位置   
  5.   
  6. '=========================================================   
  7. ' IP物理定位搜索类 Version 3.0.0   
  8. ' QQWry.DAT 利用程序 修改自互联网流传代码   
  9. ' 本类在ASP环境中使用纯真版QQWry.dat通过完美测试   
  10. ' 如果您的服务器环境不支持ADodb.Stream，将无法使用此程序   
  11. ' 推荐使用纯真数据库，更新也方便   
  12. ' ========================================================   
  13.   
  14. ' ============================================   
  15. ' 返回IP信息   
  16. ' 如address("127.0.0.1")   
  17. ' 返回值为:"本机地址 CZ88.NET"   
  18. ' ============================================   
  19. Function address(sip)   
  20. Dim Wry, IPType   
  21. Set Wry = New TQQWry   
  22. IPType = Wry.QQWry(sip)   
  23.   
  24. address=""&Wry.Country & " " & Wry.LocalStr &""   
  25. End Function   
  26.   
  27. '获得请求的实际IP地址   
  28. Function getIP()   
  29. Dim strIPAddr   
  30. If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then   
  31. strIPAddr = Request.ServerVariables("REMOTE_ADDR")   
  32. ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then   
  33. strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)   
  34. ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then   
  35. strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)   
  36. Else   
  37. strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")   
  38. End If   
  39. getIP = Trim(Mid(strIPAddr, 1, 30))   
  40. End Function   
  41.   
  42. Function Look_Ip(IP)   
  43. Dim Wry, IPType, QQWryVersion, IpCounter   
  44. ' 设置类对象   
  45. Set Wry = New TQQWry   
  46. ' 开始搜索，并返回搜索结果   
  47. ' 您可以根据 QQWry(IP) 返回值来判断该IP地址在数据库中是否存在，如果不存在可以执行其他的一些操作   
  48. ' 比如您自建一个数据库作为追捕等，这里我就不详细说明了   
  49. IPType = Wry.QQWry(IP)   
  50. ' Country：国家地区字段   
  51. ' LocalStr：省市及其他信息字段   
  52. Look_Ip = Wry.Country & " " & Wry.LocalStr   
  53. End Function   
  54. ' ============================================   
  55. ' 返回IP信息 JS调用   
  56. ' ============================================   
  57. Function GetIpInfoAv(IP, sType)   
  58. Dim Wry, IPType   
  59. Set Wry = New TQQWry   
  60. IPType = Wry.QQWry(IP)   
  61.   
  62. Select Case sType   
  63. Case 1 GetIpInfoAv = "document.write(""" & IP & """);"   
  64. Case 2 GetIpInfoAv = "document.write(""" & Wry.Country & """);"   
  65. Case 3 GetIpInfoAv = "document.write(""" & Wry.LocalStr & """);"   
  66. Case Else GetIpInfoAv = "document.write(""您来自：" & IP & " 所在区域：" & Wry.Country & " " & Wry.LocalStr & """);"   
  67. End Select   
  68. End Function   
  69. ' ============================================   
  70. ' 返回QQWry信息   
  71. ' ============================================   
  72. Function WryInfo()   
  73. Dim Wry, IPType, QQWry(1)   
  74. ' 设置类对象   
  75. Set Wry = New TQQWry   
  76. IPType = Wry.QQWry("255.255.255.255")   
  77. ' 读取数据库版本信息   
  78. QQWry(0) = Wry.Country & " " & Wry.LocalStr   
  79. ' 读取数据库IP地址数目   
  80. QQWry(1) = Wry.RecordCount + 1   
  81. WryInfo = QQWry   
  82. End Function   
  83. ' ============================================   
  84. ' 爱雪儿IP物理定位搜索类   
  85. ' ============================================   
  86. Class TQQWry   
  87. ' ============================================   
  88. ' 变量声名   
  89. ' ============================================   
  90. Dim Country, LocalStr, Buf, OffSet   
  91. Private StartIP, EndIP, CountryFlag   
  92. Public QQWryFile   
  93. Public FirstStartIP, LastStartIP, RecordCount   
  94. Private Stream, EndIPOff   
  95. ' ============================================   
  96. ' 类模块初始化   
  97. ' ============================================   
  98. Private Sub Class_Initialize   
  99. Country = ""   
  100. LocalStr = ""   
  101. StartIP = 0   
  102. EndIP = 0   
  103. CountryFlag = 0   
  104. FirstStartIP = 0   
  105. LastStartIP = 0   
  106. EndIPOff = 0   
  107. QQWryFile = Server.MapPath("QQWry.dat") 'QQ IP库路径，要转换成物理路径   
  108. End Sub   
  109. ' ============================================   
  110. ' IP地址转换成整数   
  111. ' ============================================   
  112. Function IPToInt(IP)   
  113. Dim IPArray, i   
  114. IPArray = Split(IP, ".", -1)   
  115. FOr i = 0 to 3   
  116. If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0   
  117. If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i)))   
  118. If CInt(IPArray(i)) > 255 Then IPArray(i) = 255   
  119. Next   
  120. IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3))   
  121. End Function   
  122. ' ============================================   
  123. ' 整数逆转IP地址   
  124. ' ============================================   
  125. Function IntToIP(IntValue)   
  126. p4 = IntValue - Fix(IntValue/256)*256   
  127. IntValue = (IntValue-p4)/256   
  128. p3 = IntValue - Fix(IntValue/256)*256   
  129. IntValue = (IntValue-p3)/256   
  130. p2 = IntValue - Fix(IntValue/256)*256   
  131. IntValue = (IntValue - p2)/256   
  132. p1 = IntValue   
  133. IntToIP = Cstr(p1) & "." & Cstr(p2) & "." & Cstr(p3) & "." & Cstr(p4)   
  134. End Function   
  135. ' ============================================   
  136. ' 获取开始IP位置   
  137. ' ============================================   
  138. Private Function GetStartIP(RecNo)   
  139. OffSet = FirstStartIP + RecNo * 7   
  140. Stream.Position = OffSet   
  141. Buf = Stream.Read(7)   
  142.   
  143. EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256)   
  144. 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)   
  145. GetStartIP = StartIP   
  146. End Function   
  147. ' ============================================   
  148. ' 获取结束IP位置   
  149. ' ============================================   
  150. Private Function GetEndIP()   
  151. Stream.Position = EndIPOff   
  152. Buf = Stream.Read(5)   
  153. 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)   
  154. CountryFlag = AscB(MidB(Buf, 5, 1))   
  155. GetEndIP = EndIP   
  156. End Function   
  157. ' ============================================   
  158. ' 获取地域信息，包含国家和和省市   
  159. ' ============================================   
  160. Private Sub GetCountry(IP)   
  161. If (CountryFlag = 1 Or CountryFlag = 2) Then   
  162. Country = GetFlagStr(EndIPOff + 4)   
  163. If CountryFlag = 1 Then   
  164. LocalStr = GetFlagStr(Stream.Position)   
  165. ' 以下用来获取数据库版本信息   
  166. If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then   
  167. LocalStr = GetFlagStr(EndIPOff + 21)   
  168. Country = GetFlagStr(EndIPOff + 12)   
  169. End If   
  170. Else   
  171. LocalStr = GetFlagStr(EndIPOff + 8)   
  172. End If   
  173. Else   
  174. Country = GetFlagStr(EndIPOff + 4)   
  175. LocalStr = GetFlagStr(Stream.Position)   
  176. End If   
  177. ' 过滤数据库中的无用信息   
  178. Country = Trim(Country)   
  179. LocalStr = Trim(LocalStr)   
  180. If InStr(Country, "CZ88.NET") Then Country = "114XP.CN"   
  181. If InStr(LocalStr, "CZ88.NET") Then LocalStr = "114XP.CN"   
  182. End Sub   
  183. ' ============================================   
  184. ' 获取IP地址标识符   
  185. ' ============================================   
  186. Private Function GetFlagStr(OffSet)   
  187. Dim Flag   
  188. Flag = 0   
  189. Do While (True)   
  190. Stream.Position = OffSet   
  191. Flag = AscB(Stream.Read(1))   
  192. If(Flag = 1 Or Flag = 2 ) Then   
  193. Buf = Stream.Read(3)   
  194. If (Flag = 2 ) Then   
  195. CountryFlag = 2   
  196. EndIPOff = OffSet - 4   
  197. End If   
  198. OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)   
  199. Else   
  200. Exit Do   
  201. End If   
  202. Loop   
  203.   
  204. If (OffSet < 12 ) Then   
  205. GetFlagStr = ""   
  206. Else   
  207. Stream.Position = OffSet   
  208. GetFlagStr = GetStr()   
  209. End If   
  210. End Function   
  211. ' ============================================   
  212. ' 获取字串信息   
  213. ' ============================================   
  214. Private Function GetStr()   
  215. Dim c   
  216. GetStr = ""   
  217. Do While (True)   
  218. c = AscB(Stream.Read(1))   
  219. If (c = 0) Then Exit Do   
  220.   
  221. '如果是双字节，就进行高字节在结合低字节合成一个字符   
  222. If c > 127 Then   
  223. If Stream.EOS Then Exit Do   
  224. GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C)))   
  225. Else   
  226. GetStr = GetStr & Chr(c)   
  227. End If   
  228. Loop   
  229. End Function   
  230. ' ============================================   
  231. ' 核心函数，执行IP搜索   
  232. ' ============================================   
  233. Public Function QQWry(DotIP)   
  234. Dim IP, nRet   
  235. Dim RangB, RangE, RecNo   
  236.   
  237. IP = IPToInt (DotIP)   
  238.   
  239. Set Stream = CreateObject("ADodb.Stream")   
  240. Stream.Mode = 3   
  241. Stream.Type = 1   
  242. Stream.Open   
  243. Stream.LoadFromFile QQWryFile   
  244. Stream.Position = 0   
  245. Buf = Stream.Read(8)   
  246.   
  247. 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)   
  248. 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)   
  249. RecordCount = Int((LastStartIP - FirstStartIP)/7)   
  250. ' 在数据库中找不到任何IP地址   
  251. If (RecordCount <= 1) Then   
  252. Country = "未知"   
  253. QQWry = 2   
  254. Exit Function   
  255. End If   
  256.   
  257. RangB = 0   
  258. RangE = RecordCount   
  259.   
  260. Do While (RangB < (RangE - 1))   
  261. RecNo = Int((RangB + RangE)/2)   
  262. Call GetStartIP (RecNo)   
  263. If (IP = StartIP) Then   
  264. RangB = RecNo   
  265. Exit Do   
  266. End If   
  267. If (IP > StartIP) Then   
  268. RangB = RecNo   
  269. Else   
  270. RangE = RecNo   
  271. End If   
  272. Loop   
  273.   
  274. Call GetStartIP(RangB)   
  275. Call GetEndIP()   
  276.   
  277. If (StartIP <= IP) And ( EndIP >= IP) Then   
  278. ' 没有找到   
  279. nRet = 0   
  280. Else   
  281. ' 正常   
  282. nRet = 3   
  283. End If   
  284. Call GetCountry(IP)   
  285.   
  286. QQWry = nRet   
  287. End Function   
  288. ' ============================================   
  289. ' 类终结   
  290. ' ============================================   
  291. Private Sub Class_Terminate   
  292. On ErrOr Resume Next   
  293. Stream.Close   
  294. If Err Then Err.Clear   
  295. Set Stream = Nothing   
  296. End Sub   
  297. End Class   
  298. %>  


上一篇: Asp截取中文字符
下一篇: php:json_last_error错误说明
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: asp
相关日志:
评论: 0 | 引用: 0 | 查看次数: 2894
发表评论
昵　称:
密　码: 游客发言不需要密码.
邮　箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
网　址: 输入网址便于回访.
内　容:
验证码:
选　项:
虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.
字数限制 1000 字 | UBB代码 开启 | [img]标签 关闭

 广告位

↑返回顶部↑