通过IP获取具体地址源代码（08AccessIP数据库）(页 1) - ASP技术论坛 - 编程论坛

天涯听雨 发表于 2008-6-27 18:09

通过IP获取具体地址源代码（08AccessIP数据库）

在制作评论时想实现用户来自于哪，那么这里一定得用到通过Ip来进行判断。自己在把程序写好后也共享给大家使用使用

下面的使用代码中，在连接数据进行查库时有很大的改进的，这里我就没有写出改进后的程序，留给大家发挥吧。

也只共享出Access版，Mssql存储过程版暂时保留不共享（抱歉）

下面是使用代码：

<%
if Request.ServerVariables("HTTP_X_FORWARDED_FOR")="" then
UserIp=Request.ServerVariables("REMOTE_ADDR")
else
UserIp=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
end if

function Get_IPAddress(Ip)
Dim IpStr1,IpStr2,IpStr3,IpStr4
      If Ubound(Split(Ip,"."))=3 Then
         If Ip="127.0.0.1" Then Ip="192.168.0.1"

         IpSplit=Split(Ip,".")
         IpStr1 =IpSplit(0)
         IpStr2 =IpSplit(1)
         IpStr3 =IpSplit(2)
         IpStr4 =IpSplit(3)

         if IpStr1>255 or IpStr2>255 or IpStr3>255 and IpStr4>255 then
            Get_IPAddress=""&IpStr1&"."&IpStr2&"."&IpStr3&".*"
            Exit Function
         end if

         IpNum=Cint(IpStr1)*256*256*256+Cint(IpStr2)*256*256+Cint(IpStr3)*256+Cint(IpStr4)-1

         Dim IpdbUrl,IpConnStr,IpConn,IpSqlStr

         IpdbUrl = "Acc_AddressIp.mdb"    '解压后的数据库（可以自行更改名或路径）

         IpConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(IpdbUrl)

         Set IpConn = Server.CreateObject("ADODB.Connection")
         IpConn.Open IpConnStr

         Set RsIp=IpConn.exeCute("Select top 1 Country,City from IpAddress where StartIp>="&IpNum&" and EndIp>="&IpNum&"")

         If RsIp.eof And RsIp.bof Then
            Get_IPAddress=""&IpStr1&"."&IpStr2&"."&IpStr3&".*"
         else
            '如果只想到城市取如下
            Get_IPAddress=RsIp("Country")

            '如果是取至详细，用下面代码，则需屏蔽上面
            'Get_IPAddress=""&RsIp("Country")&" "&RsIp("City")
         end if

         Set RsIp=nothing
         IpConn.Close
         Set IpConn=nothing
else
         Get_IPAddress=""
end if
End Function

'调用结果放到你希望的位置即可
Response.Write"欢迎来自"&Get_IPAddress(UserIp)&"的朋友"
%>

08AccessIP数据库地址：http://www.5wiki.cn/upload/vip/5/20086271835981.rar
所收录的IP地址，我已经通纯真IP数据库升级到最新的（当天）

[[it] 本帖最后由天涯听雨于 2008-6-27 18:20 编辑 [/it]]

tianyu123 发表于 2008-6-27 18:34

学习...

先试试去

piaoxue 发表于 2008-6-27 19:50

哎！还有说保留？？贡献把楼主呵呵[tk05]

multiple1902 发表于 2008-6-27 21:57

我用xmlhttp获取
http://www.zxxk.com/ipaddress.asp?ip=127.0.0.1
很喜欢这个页面，非常简洁

天涯听雨 发表于 2008-6-27 23:34

http://www.zxxk.com/ipaddress.asp?ip=127.0.0.1

其实这原理过程还是要进行执行查库读取，可以说只是表现方法不同，利用Ajax异步读取。

方法值得一学习！

[[it] 本帖最后由天涯听雨于 2008-6-27 23:37 编辑 [/it]]

lele2007 发表于 2008-6-28 09:29

<%
function GetResStr(URL,code)
err.clear
dim ResBody,ResStr,PageCode,ReturnStr
Set Http=server.createobject("msxml2.serverxmlhttp.3.0")
Http.setTimeouts 10000, 10000, 10000, 10000
Http.open "GET",URL,False
Http.Send()
If Http.Readystate =4 Then
  If Http.status=200 Then
ResBody=http.responseBody
ReturnStr=BytesToBstr(http.responseBody,code)
GetResStr=ReturnStr
  End If
End If
End Function

'函数名:BytesToBstr
'作用:转换二进制数据为字符
'参数:Body-二进制数据,Cset-文本编码方式
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

dim reg,vUrl,VBody,code,time1,time2,title
vUrl="http://www.cz88.net/ip/ipcheck.aspx?ip="&request.servervariables("REMOTE_ADDR")
TempStr=GetResStr(vUrl,"gb2312")
p1=instr(TempStr,"""")+1
p2=InStrRev(TempStr,"""")
Add=mid(TempStr,p1,p2-p1)

response.write "您的IP为:"&request.servervariables("REMOTE_ADDR")&"<br />"
response.write "您的位置:"&Add&"<br />"
%>

我用这个也可以，但看不懂[tk01]

multiple1902 发表于 2008-6-28 17:29

回楼上的，就是先用xmlhttp获取那个网站查IP的网页，然后因为有很多内容是不需要的，所以通过字符串操作获取需要的“物理位置”。

lele2007 发表于 2008-6-28 23:27

回复：版主（楼上）
http://www.cz88.net/ip/ipcheck.aspx?ip="&request.servervariables("REMOTE_ADDR")
通过这个获得的吧，呵呵，谢谢了！慢慢再弄懂！[tk05]

anlige 发表于 2008-6-29 01:06

http://blog.ii-home.cn/

[quote][bo][un]lele2007[/un] 在 2008-6-28 09:29 的发言：[/bo]

[/quote]
呵呵~~csdn弄了来的？~~俺写的~呵呵~
[url=http://blog.ii-home.cn/]http://blog.ii-home.cn/[/url]
[qq]417833272[/qq][tk08]

[[it] 本帖最后由 anlige 于 2008-6-29 01:07 编辑 [/it]]

anlige 发表于 2008-6-29 01:08

不过我现在直接改用xmlhttp
<%
function  GetResStr(URL,code)
err.clear
dim  ResBody,ResStr,PageCode,ReturnStr
Set  Http=server.createobject("Microsoft.XMLHTTP")
Http.open  "GET",URL,False
Http.Send()
If  Http.Readystate  =4  Then
If  Http.status=200  Then
      ResBody=http.responseBody
      ReturnStr=BytesToBstr(http.responseBody,code)
      GetResStr=ReturnStr
End  If
End  If
End  Function

'函数名:BytesToBstr
'作用:转换二进制数据为字符
'参数:Body-二进制数据,Cset-文本编码方式
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

dim  reg,vUrl,VBody,code,time1,time2,title
vUrl="http://www.cz88.net/ip/ipcheck.aspx?ip="&request.servervariables("REMOTE_ADDR")
TempStr=GetResStr(vUrl,"gb2312")
p1=instr(TempStr,"""")+1
p2=InStrRev(TempStr,"""")
Add=mid(TempStr,p1,p2-p1)

response.write  "您的IP为:"&request.servervariables("REMOTE_ADDR")&"<br  />"
response.write  "您的位置:"&Add&"<br  />"
%>

页: [1]

编程论坛's Archiver

通过IP获取具体地址源代码（08AccessIP数据库）

http://blog.ii-home.cn/