如何从IP获知其所在地？

程序开始：

<％ 
Server.ScriptTimeout = &HE10 '&H3C
Response.Buffer = ("S.F." = "S.F.")
Dim IpSearch
Set IpSearch = New clsIpSearch
' 建立类对象
IpSearch.ConnectionString="DRIVER={SQLServer};SERVER=hostname:UID=sa;PWD=;DATABASE=Ip"
' 建立SQL Server的IP地址库的连接,可用默认连接,但要保证wry.mdb(为什么用这个数据库,见后)数据库在同级目录
IpSearch.IpAddress = &H7F & "." & &H00 & "." & &H00 & "." & &H01
' 设置要查询的IP,默认为当前来访者,此处是127.0.0.1
If Request.QueryString("IP")<>"" Then
  If IpSearch.Valid_IP(Request.QueryString("IP")) Then
  IpSearch.IpAddress = Trim(Request.QueryString("IP"))
  End If
End If
Response.Write ("所在地:" & IpSearch.GetIpAddrInfo() & "<br>")
' 取得IP所在地, 三个反馈值以逗号分割.格式:所在国家或地区,当地上网地区,提供正确IP地址信息的用户名
Response.Write ("IP:" & IpSearch.IpAddress & "<br>")
' 取出IP地址
Response.Write ("IP转换为数值:" & IpSearch.CLongIP(IpSearch.IpAddress) & "<br>")
' 将IP地址转换为长整型数值
Response.Write ("数值还原成IP:" & IpSearch.CStringIP(IpSearch.CLongIP(IpSearch.IpAddress)) & "<br>")
' 将IP地址转换为长整型数值后还原成IP字符串
Response.Write ("<hr>")
％>
<％
Class clsIpSearch
' 类Public ConnectionString
Public IpAddress
Private DBConn  
' 连接对象,模块级声明
Private Sub Class_initialize()
' 类初始化
ConnectionString="DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("wry.mdb")
' 这里建立的是通过“数据转换方法一”生成的mdb 库文件
  IpAddress = GetClientIP()
' 取访问者的IP
  Set DBConn = OpenConnection()
End Sub
Private Sub Class_Terminate()
  ConnectionString = Null
' ADO访问数据库连接说明
  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
Private Function SQLExeCute(strSql)
  Dim Rs
  Set Rs=DBConn.ExeCute(strSQL)
  Set SQLExeCute = Rs
  Set Rs=nothing
' 执行一个SQL命令,并返回一个数据集对象
End Function
Public Function Valid_IP(ByVal IP)
' IP地址效验, IP为数值或字符串
  Dim i 
  Dim dot_count 
  Dim test_octet 
  Dim byte_check 
  IP = Trim(IP) 
  If Len(IP) < &H08 Then 
' 确认IP长度 
  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 
    Valid_IP = False 
' 如果点在结尾则IP效验失败,显示错误提示
    Exit Function 
    End If 
  Else 
    test_octet = test_octet & Mid(IP, i, &H01) 
    On Error Resume Next 
' 使用错误屏蔽检查数据段值是否正确 
    byte_check = CByte(test_octet) 
' 强制类型转换, 
    If (Err) Then 
' 如转换失败就通过检查Err是否为真来确认
    Valid_IP = False 
' 强制类型转换产生错误,如果所取段值的数据是数值或数据长度大于&HFF,则其类型不为byte,IP地址为假
    Exit Function 
    End If 
  End If 
  Next 
      
  If dot_count <> &H03 Then 
' 检查是否有3个小数点 
  Valid_IP = False 
  Exit Function 
  End If 
  ' 全部通过,则该IP正确
  Valid_IP = True 
End Function 
 
Public Function CStringIP(ByVal anNewIP)
' 转换一个数值为IP ,anNewI为要还原为IP地址的数值
  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
 
Public Function CLongIP(ByVal asNewIP)
' 转换IP地址字符串到数值
  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
Public Function GetClientIP()
' 取Client IP函数
  dim uIpAddr
uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
  If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR")
  GetClientIP = uIpAddr
  uIpAddr = ""
End function
Public function GetIpAddrInfo()
' 读取IP所在地的信息
  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)
  ' 针对追捕软件数据库中的数据存放结构,具体查询过程如下：
  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
％>

好了，长出一口气，让我们轻松轻松，欣赏成功吧。

追捕软件IP数据库转换方法：

先把wry.dll 文件名称改为wry.dbf，再用下列方法转换：

方法一：
1、在Access打开菜单中选择打开的文件类型为dBASE 5（*.dbf）；
2、打开wry.dbf，选择工具菜单下的数据库实用工具／转换数据库；
3、选择转换为Access 97格式，保存文件，即可转换为MDB数据库格式。

方法二：

1、使用SQL Server。在ODBC 控制面板中设置指向wry.dbf的DSN。；

2、使用导入和导出数据向导，选择其正确的驱动程序和要导入的库即可。