一个无须数据库查询IP所在地的函数

sunlei

  <%
'------------------------------
'无须数据库查询Ip所在地函数
'By:Neeao
'------------------------------
response.write SelectIP("127.0.0.1") '测试用的语句，可以删除！

Function SelectIP(ip)
Dim wstr,str,url,start,over,city
url="http://dheart.51.net/ip/index.php?ip="&ip&""
wstr=getHTTPPage(url)
start=Newstring(wstr,"<br><br>")
over=Newstring(wstr,"<form method")
body=mid(wstr,start,over-start)
body = replace(body,"<br>","")
body = replace(body,ip,"")
response.write body
End Function

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

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

Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
If Newstring<=0 then Newstring=Len(wstr)
End Function
%>

sunlei

  <%
'------------------------------
'无须数据库查询Ip所在地函数
'By:Neeao
'------------------------------
response.write SelectIP("127.0.0.1") '测试用的语句，可以删除！

Function SelectIP(ip)
Dim wstr,str,url,start,over,city
url="http://dheart.51.net/ip/index.php?ip="&ip&""
wstr=getHTTPPage(url)
start=Newstring(wstr,"<br><br>")
over=Newstring(wstr,"<form method")
body=mid(wstr,start,over-start)
body = replace(body,"<br>","")
body = replace(body,ip,"")
response.write body
End Function

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

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

Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
If Newstring<=0 then Newstring=Len(wstr)
End Function
%>

sunlei

  <%
'------------------------------
'无须数据库查询Ip所在地函数
'By:Neeao
'------------------------------
response.write SelectIP("127.0.0.1") '测试用的语句，可以删除！

Function SelectIP(ip)
Dim wstr,str,url,start,over,city
url="http://dheart.51.net/ip/index.php?ip="&ip&""
wstr=getHTTPPage(url)
start=Newstring(wstr,"<br><br>")
over=Newstring(wstr,"<form method")
body=mid(wstr,start,over-start)
body = replace(body,"<br>","")
body = replace(body,ip,"")
response.write body
End Function

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

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

Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
If Newstring<=0 then Newstring=Len(wstr)
End Function
%>

sunlei

  <%
'------------------------------
'无须数据库查询Ip所在地函数
'By:Neeao
'------------------------------
response.write SelectIP("127.0.0.1") '测试用的语句，可以删除！

Function SelectIP(ip)
Dim wstr,str,url,start,over,city
url="http://dheart.51.net/ip/index.php?ip="&ip&""
wstr=getHTTPPage(url)
start=Newstring(wstr,"<br><br>")
over=Newstring(wstr,"<form method")
body=mid(wstr,start,over-start)
body = replace(body,"<br>","")
body = replace(body,ip,"")
response.write body
End Function

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

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

Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
If Newstring<=0 then Newstring=Len(wstr)
End Function
%>