一个无须数据库查询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
%>

屋顶上的轻骑兵

　这段源码并没有什么特别，只不过它是先取IP，

然后用“http://dheart.51.net/ip/index.php?ip=”这个网址的分析IP的功能

来分析IP所在地罢了。

kokgog

you  dao  li  a

可酷可乐

说白了就是一小偷

大傻瓜不傻

不能说是小偷来的
他没有偷什么东东哦
只是转向而已
让别的网站去分析
^_^

zxt856

哈哈 还有其他可分析IP的功能的网址吗？

bluejack

有 我 弄的 你要不！
还在我本地   没传呢
哇 咔咔

zxt856

不明白?

jdan

试试看，呵呵

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
%>