在制作评论时想实现用户来自于哪，那么这里一定得用到通过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.
所收录的IP地址，我已经通纯真IP数据库升级到最新的（当天）

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

学习...

先试试去

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

我用xmlhttp获取
http://www.
很喜欢这个页面，非常简洁

http://www.

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


方法值得一学习！

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

<%
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.("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 />"
%>




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

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

回复：版主（楼上）
http://www.("REMOTE_ADDR")
通过这个获得的吧，呵呵，谢谢了！慢慢再弄懂！

呵呵~~csdn弄了来的？~~俺写的~呵呵~
[url=http://blog.]http://blog.[/url]


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

不过我现在直接改用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.("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  />"
%>