共两个文件,getip.asp和index.asp,具体代码如下:

<!--------------getip.asp内容开始---------------------->
<%
On Error Resume Next
function getHTTPPage(url)
    dim Http
    set Http=server.createobject("MSXML2.XMLHTTP")
    Http.open "GET",url,false
    Http.send()
    if Http.readystate<>4 then
        exit function
    end if
    getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
    set http=nothing
    if err.number<>0 then err.Clear
end function
\'==================================================
\'函数名：GetBody
\'作  用：截取字符串
\'参  数：ConStr ------将要截取的字符串
\'参  数：StartStr ------开始字符串
\'参  数：OverStr ------结束字符串
\'参  数：IncluL ------是否包含StartStr
\'参  数：IncluR ------是否包含OverStr
\'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If C or C" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   \'response.write Start&"<br>"&IncluL&"<br>"
   \'response.end
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
  
   GetBody=MidB(ConStr,Start,Over-Start)
End Function
Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText
        objstream.Close
        set objstream = nothing
End Function
%>
<%
ip=Request.ServerVariables("REMOTE_ADDR")

cc=split(ip,".")  
ip2=cc(0)&"."&cc(1)&"."&cc(2)&".***"  

url="http://www.ip138.com/ips.asp?ip="&ip&""                 \'要获取的网页地址
html=getHTTPPage(url)  

dlwz=getBody(html,"本站主数据：","</li>",false,false)

if dlwz="$False$" then
dlwz="未知区域"
end if

\'ip              是完全的ip                                       如:210.42.159.168
\'ip2             用ASP将IP地址最后一段的数字替换成***             如:210.42.159.***
\'dlwz            获取ip的地理位置                                 如:湖北省武汉市中南民族大学
%>
<!--------------getip.asp内容结束---------------------->

<!--------------index.asp显示页开始---------------------->
<!--#include file="getip.asp"-->
<%=ip%><br>
<%=ip2%><br>
<%=dlwz%><br /><br><br><br><br><br><br>

<!--------------index.asp显示页结束---------------------->

使用说明
ip 是完整真实的ip                            如:210.42.159.168
ip2 用ASP将IP地址最后一段的数字替换成***   如:210.42.159.***
dlwz 获取ip的地理位置 如：湖北省武汉市中南民族大学
调用时只需要要你要调用的页面中加入<!--#include file="getip.asp"-->中即可，有以上的ip,ip2,dlwz三个字段供你使用


http://jxhgt.blog.163.com/blog/static/13484013420103291014101/