ASP实现IP地址转换为真实地址

作者：管理员

发布时间：2013/1/16 14:26:42

评论数：0

转载请自觉注明原文：http://www.jq-school.com/Show.aspx?id=213

此文章由网友【水墨寒】提供

 

实现的功能代码如下：

 

<%
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,"utf-8")
    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 ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" 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.baidu.com/s?wd="&ip&""                 '要获取的网页地址
html=getHTTPPage(url)   

dlwz=getBody(html,"</p><p class=""op_ip_detail"">","</strong></p>",false,false)
if dlwz="$False$" then
dlwz="未知地区"
end if
%>

关键字：asp知识 asp学习文章 asp获取IP地址 IP地址转换为真实地址