ASP编写完整的一个IP所在地搜索类

作者：佚名 | 来源：网络 | 添加时间：2006-04-03 22:56:42 | 人气：1744

ASP编写完整的一个IP所在地搜索类（2）

   Public ConnectionString
   Public IpAddress
   Private DBConn ’连接对象，模块级声明
   ’────────────────────────────────
   ’ 类初始化
   Private Sub Class_initialize()
   ’ 这里建立的是通过“数据转换--方法一”生成的mdb 库文件
   ConnectionString="DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("wry.mdb")
   IpAddress = GetClientIP()
   Set DBConn = OpenConnection()
   End Sub
   ’────────────────────────────────
   ’ 类注销
   Private Sub Class_Terminate()
   ConnectionString = Null
   IpAddress = Null
   DBConn.Close
   Set DBConn = Nothing
   End Sub
   ’────────────────────────────────
   ’ 建立一个连接
   Private Function OpenConnection()
   Dim tmpConn
   Set tmpConn=Server.CreateObject("ADODB.Connection")
   tmpConn.Open ConnectionString
   Set OpenConnection=tmpConn
   Set tmpConn=nothing
   End Function
   ’────────────────────────────────
   ’ 执行一个SQL命令，并返回一个数据集对象
   Private Function SQLExeCute(strSql)
   Dim Rs
   Set Rs=DBConn.ExeCute(strSQL)
   Set SQLExeCute = Rs
   Set Rs=nothing
   End Function
   ’────────────────────────────────
   ’IP 效验
   Public Function Valid_IP(ByVal IP)
   Dim i
   Dim dot_count
   Dim test_octet
   Dim byte_check
   IP = Trim(IP)
   ’ 确认IP长度
   If Len(IP) < &H08 Then
   Valid_IP = False
   ’显示错误提示
   Exit Function
   End If

   i = &H01
   dot_count = &H00
   For i = 1 To Len(IP)
   If Mid(IP, i, &H01) = "." Then
   ’ 增加点的记数值
   ’ 并且设置text_octet 值为空
   dot_count = dot_count + &H01
   test_octet = ""
   If i = Len(IP) Then
   ’ 如果点在结尾则IP效验失败
   Valid_IP = False
   ’ 显示错误提示
   Exit Function
   End If
   Else
   test_octet = test_octet & Mid(IP, i, &H01)
   ’ 使用错误屏蔽来检查数据段值的正确性
   On Error Resume Next
   ’ 进行强制类型转换
   ’ 如果转换失败就可通过检查Err是否为真来确认
   byte_check = CByte(test_octet)
   If (Err) Then
   ’ 强制类型转换产生错误
   ’ 所取段值的数据不为数值
   ’ 或所取段值的数据长度大于&HFF
   ’ 则类型不为byte类型
   ’ IP 地址的正确性为假
   Valid_IP = False
   Exit Function
   End If
   End If
   Next

   ’ 通过上一步的验证，现在应该要检查小点是否有3个
   If dot_count <> &H03 Then
   Valid_IP = False
   Exit Function
   End If
   ’ 一切正常，那么该IP为正确的IP地址
   Valid_IP = True
   End Function
   ’────────────────────────────────
   ’ 转换一个数值为IP
   Public Function CStringIP(ByVal anNewIP)
   Dim lsResults
   Dim lnTemp
   Dim lnIndex
   For lnIndex = &H03 To &H00 Step -&H01
   lnTemp = Int(anNewIP / (&H100 ^ lnIndex))
   lsResults = lsResults & lnTemp & "."
   anNewIP = anNewIP - (lnTemp * (&H100 ^ lnIndex))
   Next
   lsResults = Left(lsResults, Len(lsResults) - &H01)
   CStringIP = lsResults
   End function
   ’────────────────────────────────
   ’ 转换一个IP到数值
   Public Function CLongIP(ByVal asNewIP)
   Dim lnResults
   Dim lnIndex
   Dim lnIpAry
   lnIpAry = Split(asNewIP, ".", &H04)
   For lnIndex = &H00 To &H03
   if Not lnIndex = &H03 Then
   lnIpAry(lnIndex) = lnIpAry(lnIndex) * (&H100 ^ (&H03 - lnIndex))
   End if
   lnResults = lnResults + lnIpAry(lnIndex)
   Next
   CLongIP = lnResults
   End function
   ’────────────────────────────────
   ’ 取Client IP
   Public Function GetClientIP()
   dim uIpAddr
   ’ 本函数参考webcn.Net/AspHouse 文献<取真实的客户IP>
   uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
   If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR")
   GetClientIP = uIpAddr
   uIpAddr = ""
   End function
   ’────────────────────────────────
   ’ 读取IP所在地的信息
   Public function GetIpAddrInfo()
   Dim tmpIpAddr
   Dim IpAddrVal
   Dim ic,charSpace
   Dim tmpSQL
   charSpace = ""
   IpAddrVal = IpAddress
   If Not Valid_IP(IpAddrVal) Then
   GetIpAddrInfo =NULL
   Exit Function
   End If
   ’将IP字符串劈开成数组好进行处理
   tmpIpAddr = Split(IpAddrVal,".",-1,1)
   For ic = &H00 To Ubound(tmpIpAddr)
   ’补位操作,保证每间隔满足3个字符
   Select Case Len(tmpIpAddr(ic))
   Case &H01 :charSpace = "00"
   Case &H02 :charSpace = "0"
   Case Else :charSpace = ""
   End Select
   tmpIpAddr(ic) = charSpace & tmpIpAddr(ic)
   Next
   IpAddrVal = tmpIpAddr(&H00) & "." & tmpIpAddr(&H01) & "." & tmpIpAddr(&H02) & "." & tmpIpAddr(&H03)

   ’以下为查询，IP地址库基于《追捕》的IP数据库,感谢"冯志宏"先生的贡献
   ’库结构如下：
   ’CREATE TABLE [dbo].[wry] (
   ’ [STARTIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --起始IP段
   ’ [ENDIP] [nvarchar] (17) COLLATE Chinese_PRC_CI_AS NULL , --终止IP段
   ’ [COUNTRY] [nvarchar] (16) COLLATE Chinese_PRC_CI_AS NULL , --国家或者地区
   ’ [LOCAL] [nvarchar] (54) COLLATE Chinese_PRC_CI_AS NULL , --本地地址
   ’ [THANK] [nvarchar] (23) COLLATE Chinese_PRC_CI_AS NULL --感谢修正IP地址用户姓名
   ’) ON [PRIMARY]
   ’经过分析库的数据存放结构，总结出准确的查询方法，具体看下面的查询过程
   tmpSQL = "select * from wry where (startIP<=’" & IpAddrVal & "’) and (ENDIP>=’" & IpAddrVal & "’) " & _
   " and left(startIP," & Len(tmpIpAddr(&H00)) & ") = ’" & tmpIpAddr(&H00) & "’" & _
   " and left(endip," & Len(tmpIpAddr(&H00)) & ")=’" & tmpIpAddr(&H00) & "’"
   charSpace = GetDbIpInfo(tmpSQL)
   If Len(charSpace)=&H00 Then
   GetIpAddrInfo = NULL
   Else
   GetIpAddrInfo = charSpace
   End If
   charSpace = Null
   tmpSQL = Null
   end function
   ’────────────────────────────────
   ’ 返回数据查询的字符串
   Private function GetDbIpInfo(byVal sql)
   Dim OpenIpSearchRs
   Dim result
   Set OpenIpSearchRs = SQLExeCute(sql)
   If Not OpenIpSearchRs.Eof Then
   result = NullToSpace(OpenIpSearchRs("COUNTRY")) & "," & NullToSpace(OpenIpSearchRs("LOCAL")) & "," & NullToSpace(OpenIpSearchRs("THANK"))
   Else
   result = NULL
   End If
   OpenIpSearchRs.Close
   Set OpenIpSearchRs=Nothing
   GetDbIpInfo = result
   End function
   ’────────────────────────────────
   ’ 将数据库空记录转换为空字符
   Private function NullToSpace(byVal rsStr)
   If isNull(rsStr) Then
   NullToSpace = ""
   Else
   NullToSpace = Trim(rsStr)
   End If
   End Function
  End Class
  %>

责任编辑：冬天来了