wapls_conn.asp

蓝色WAP建站系统,WAP源码,更多请登陆http://xywap.cn

<%
'==================================
'=文 件 名：wapls_conn.asp
'=适用版本：蓝色世纪WAP网站管理系统(CMS)V1.1
'=官方版权：http://www.wapls.com
'=文件功能：网站数据库连接及相关的限制
'=文件作者：蓝色阳光
'=发行时间：2007-02-01
'==================================
'==================================
'=功    能：数据库地址设置.根据相应情况作更改.名称越复杂越好.
'==================================
dim conn,connstr,db
db="mdb/mdb.mdb"
connstr="provider=microsoft.jet.oledb.4.0;data source=" & server.mappath(db)
set conn = server.createobject("adodb.connection")
conn.open connstr
	if err then
		err.clear
		set conn = nothing
		response.write "<card title=""网站出错了""><p>"
		response.write "网站数据库连接出错,请检查wapls_conn.asp连接设置是否正确.</p></card></wml>"
		response.end
	end if
'关闭数据库连接函数
function closedatabase
	conn.close
	set conn = nothing
end function
%>
<!--#include file="wapls_ubb.asp"-->
<!--#include file="wapls_config.asp"-->
<%
on error resume next
'==================================
'=功    能：非手机IP地址限制访问
'==================================
request_ip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If request_ip = "" Then request_ip = Request.ServerVariables("REMOTE_ADDR")
if web_ok="0" then
if len("request_ip")>0 then
ip=left(request_ip,1)
end if
if ip<>2 then
browsers=Lcase(Left(Request.ServerVariables("HTTP_USER_AGENT"),4))
if browsers="oper" or browsers="winw" or browsers="wapi" or browsers="mc21" or browsers="up.b" or browsers="upg1" or browsers="upsi" or browsers="qwap" or browsers="jigs" or browsers="java" or browsers="alca" or browsers="wapj" or browsers="cdr/" or browsers="nec-" or browsers="fetc" or browsers="r380" or browsers="winw" or  browsers="wap/" or  browsers="mozi" or browsers="m3ga" then
response.write "<card title=""访问出错了""><p>很抱歉.本站属于WAP站点请使用开通了GPRS的手机访问我们网站.</p></card></wml>"
response.end
end if
end if
end if 
'==================================
'=功    能：IP地址限制访问
'==================================
userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")
replace_ip="|"&replace_ip
ipb = InStr(1, request_ip, ".") 
ipc = InStr(1, mid(request_ip,ipb+1), ".")
ipd = InStr(1, mid(mid(request_ip,ipb+1),ipc+1), ".")
if instr(1,replace_ip,"|" & left(request_ip,ipb) & "*") or instr(1,replace_ip,"|" & left(request_ip,ipb+ipc) & "*") or instr(1,replace_ip,"|" & left(request_ip,ipb+ipc+ipd) & "*") or instr(1,replace_ip,"|" & request_ip) then
response.write "<card title=""网站出错了""><p>很抱歉.本功能暂停开放.请稍后再试.</p></card></wml>"
response.end
end if
'==================================
'=功    能：网站维护限制访问
'==================================
if weihu=1 then
response.write "<card title=""网站维护中""><p>很抱歉.由于以下原因网站暂停开放<br/>"&weihu_case&"<br/>预计的时间"&weihu_time&"!</p></card></wml>"
response.end
end if
'==================================
'=功    能：关键字过滤
'==================================
function keys(str)
	word=replace_word
	reword=split(word,"|")
	for i=0 to ubound(reword)
		if i=0 then
			restr=replace(str,reword(i),"***")
		else
			restr=replace(re_1,reword(i),"***")
		end if
		re_1=restr
	next
	keys=restr
end function
'==================================
'=功    能：字符验证
'==================================
function strLength(str)
	ON ERROR RESUME NEXT
	dim WINNT_CHINESE
	WINNT_CHINESE    = (len("中国")=2)
	if WINNT_CHINESE then
        dim l,t,c
        dim i
        l=len(str)
        t=l
        for i=1 to l
        	c=asc(mid(str,i,1))
            if c<0 then c=c+65536
            if c>255 then
                t=t+1
            end if
        next
        strLength=t
    else 
        strLength=len(str)
    end if
    if err.number<>0 then err.clear
end function
'==================================
'函数名：BPCheckEMail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'        False ----Email地址不合法
'==================================
function BPCheckEMail(email)
	dim names, name, i, c
	BPCheckEMail = true
	names = Split(email, "@")
	if UBound(names) <> 1 then
	   BPCheckEMail = false
	   exit function
	end if
	for each name in names
		if Len(name) <= 0 then
			BPCheckEMail = false
    		exit function
		end if
		for i = 1 to Len(name)
		    c = Lcase(Mid(name, i, 1))
			if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
		       BPCheckEMail = false
		       exit function
		     end if
	   next
	   if Left(name, 1) = "." or Right(name, 1) = "." then
    	  BPCheckEMail = false
	      exit function
	   end if
	next
	if InStr(names(1), ".") <= 0 then
		BPCheckEMail = false
	   exit function
	end if
	i = Len(names(1)) - InStrRev(names(1), ".")
	if i <> 2 and i <> 3 then
	   BPCheckEMail = false
	   exit function
	end if
	if InStr(email, "..") > 0 then
	   BPCheckEMail = false
	end if
end function
%>