在外贸网站,为了禁止同行抄袭，所以防止中国ip访问访问,访问的时候有密码提示,这样代码码和大家分享下

index.asp

<!--#include file="chk.asp"-->
这是你网页正常显示的内容

chk.asp

<%

'[session("canRead") = ""  or "OK" ] to judge it!

if Instr(getIPAddress(),"中国")>0 and session("canRead")="" then
 response.Redirect("login.asp")
end if

Function leleToStr(str)
 Dim stream
 Set stream=Server.CreateObject("ADODB.Stream")
 With stream
  .Type=1
  .Mode=3
  .Open
  .Write str
  .Position = 0
  .Type = 2
  .Charset = "gb2312"
  leleToStr = .ReadText
  .Close
 End With
 Set stream=Nothing
End Function

'获取IP所在地区
Function getIPAddress()
 on error resume next
 dim xmlhttp,url
 url = "http://ip.qq.com"
 set xmlhttp = server.CreateObject("Msxml2.XMLHTTP")
 xmlhttp.open "get",url,false
 xmlhttp.send
 
 '开始截取字符      
 dim StartStr,EndStr,html
 html = leleToStr(xmlhttp.responseBody)
 StartStr = Instr(html,"所在地为：")      
 EndStr = Instr(html,"如果该IP")      
 html = mid(html,StartStr,EndStr-StartStr)
 
 '再次获取
 StartStr = Instr(html,"")
 StartStr = StartStr + 6
 EndStr = Instr(html,"")
 html = mid(html,StartStr,EndStr-StartStr)
 
 getIPAddress = html
 if err then err.clear:html = ""
 set xmlhttp = nothing
End Function

%>

login.asp

 <%
 if Request.ServerVariables("REQUEST_METHOD")="POST" then
  if trim(request("pass"))="blueidea" then
   session("canRead")="OK"
   response.Redirect("index.asp")
  else
   response.Write("密码错误，返回重试！")
   response.End()
  end if
 end if
%>

程序打包下载

 /UpFile/201211/2012110479480577.rar

调用的纯真在线数据库！