www.gusucode.com > 易心博客[圣诞版] 3.5手动安装码程序 > inc/function.asp

    <%
'****************************************************
'清除html标记
'参数 str----要清除的字符串
'****************************************************
Function cleanHtml(str)
Dim re
Set re=new regExp
re.pattern="(\<)(.*?)(\>)"
re.IgnoreCase =false
re.Global=True
str=re.Replace(str,"")
cleanHtml=str
End Function
'****************************************************
'增加<br>标记
'参数 str----要增加的字符串
'****************************************************
Function FilterHtml(str)
    FilterHtml=replace(str, chr(13), "<BR>")
End Function
'****************************************************
'检测用户名是否被占用
'参数 str----用户名
'****************************************************
sub checkname(str)
    dim rs
	rs=db.execute ("select count(*) as num from user where username='"&trim(str)&"'")
	if rs("num")<>0 then
    response.Write("<script>alert('用户名已经被占用')</script>")
    response.Write("<script>history.go(-1)</script>")
    response.end
	end if
End sub
'****************************************************
'检测留言评论提交时用户的合法性
'参数 username----用户名  pwd----密码
'****************************************************
sub checkuser(username,pwd)
    dim rs,sql
	set rs=server.CreateObject("adodb.recordset")
	sql="select userpwd,lock from user where username='"&username&"'"
	rs.open sql,db,1,1
	'response.Write(rs.recordcount)
	if rs.recordcount<>0 then
		if rs("userpwd")<>pwd then
    	response.Write("<script>alert('用户名已经被占用\n如果你注册了这个用户名请登陆后或填写正确密码后再提交信息')</script>")
    	response.Write("<script>history.go(-1)</script>")
    	response.end
		end if
		if rs("lock")=true then
    	response.Write("<script>alert('用户已经被锁定，如有疑问请留言')</script>")
    	response.Write("<script>history.go(-1)</script>")
    	response.end
		end if
	end if
End sub
'************************************************
'判断是否存在没有闭合的标记  存在返回true 否则返回false
'参数：str 待判断的字符串
'************************************************
function checktag(str)
	Dim re
Set re=new regExp
re.pattern="(\<)(.*?)(\>)"
re.IgnoreCase =false
re.Global=True
str=re.Replace(str,"")
if instr(str,"<")<>0 then
checktag=true
else
checktag=false
end if
end function
'**************************************************
'截取不闭合的部分(转变为ubb模式时用)
'参数:str--要处理的字符串
'**************************************************
function cutstr(str)
dim i
i=instr(str,"<")
cutstr=left(str,i-1)
end function
'**************************************************
'把 img object embed p font br标记转化为ubb形式
'参数:str---待处理的字符串
'**************************************************
function html2ubb(str)
dim re
set re=new regexp
re.ignorecase=true
re.global=true
re.pattern="\n"
str=re.replace(str," ")
re.pattern="\r"
str=re.replace(str," ")
re.pattern="(\<img)(.*?)(\>)"
str=re.replace(str,"[img $2]")
re.pattern="(\<object)(.*?)(\>)"
str=re.replace(str,"[object $2]")
re.pattern="<\/object>"
str=re.replace(str,"[/object]")
re.pattern="(\<embed)(.*?)(\>)"
str=re.replace(str,"[embed $2]")
re.pattern="<\/embed>"
str=re.replace(str,"[/embed]")
re.pattern="(\<font)(.*?)(\>)"
str=re.replace(str,"[font $2]")
re.pattern="<\/font>"
str=re.replace(str,"[/font]")
re.pattern="(\<p)(.*?)(\>)"
str=re.replace(str,"[exp]")
re.pattern="<\/p>"
str=re.replace(str,"[/exp]")
re.pattern="<br>"
str=re.replace(str,"[br]")
html2ubb=str
end function

'**************************************************
'把 img object embed p font br标记转化为html形式
'参数:str---待处理的字符串
'**************************************************
function ubb2html(str)
dim re
set re=new regexp
re.ignorecase=true
re.global=true
re.pattern="\[img(.*?)\]"
str=re.replace(str,"<img $1 onload='javascript:if (this.width>400){this.resize=true;this.width=400;}'>")
re.pattern="\[object(.*?)\]"
str=re.replace(str,"<object $1>")
re.pattern="\[\/object\]"
str=re.replace(str,"</object>")
re.pattern="\[embed(.*?)\]"
str=re.replace(str,"<embed $1>")
re.pattern="\[\/embed\]"
str=re.replace(str,"</embed>")
re.pattern="\[font(.*?)\]"
str=re.replace(str,"<font $1>")
re.pattern="\[\/font\]"
str=re.replace(str,"</font>")
re.pattern="\[exp\]"
str=re.replace(str,"")
re.pattern="\[\/exp\]"
str=re.replace(str,"<br><br>")
re.pattern="\[br\]"
str=re.replace(str,"<br>")
ubb2html=str
end function
'*******************************************
'检测某个字符串出现的次数
'str ---要检测的字符串 childstr---子字符串
'*******************************************
function checkcount(byval str,childstr)
str=split(str,childstr)
checkcount=ubound(str)
end function
'*******************************************
'img object embed p font标记匹配检测 清除不匹配的标记(html状态下用)
'str 要检测的字符串
'*******************************************
function checkpattern(byval str)
dim temp
temp=str
if checkcount(str,"<embed")<>checkcount(str,"</embed>") then
	temp=split(str,"<embed")
	str=replace(str,temp(ubound(temp)),"")
end if
if checkcount(str,"<object")<>checkcount(str,"</object>") then
	temp=split(str,"<object")
	str=replace(str,temp(ubound(temp)),"")
end if
if checkcount(str,"<font")<>checkcount(str,"</font>") then
	temp=split(str,"<font")
	str=replace(str,temp(ubound(temp)),"")
end if
checkpattern=str
end function
'********************************************
'修正连接 如果没有http://就添加
'str--要检测的字符串
'********************************************
function checkhttp(str)
if instr(str,"http://")=0 then
	checkhttp="http://"&str
else
	checkhttp=str
end if
end function
'********************************************
'回复信息过滤
'str--要过滤的字符串
'********************************************
Function filterCmt(str)
Dim re
Set re=new regexp
re.ignorecase=True
re.multiline=True
re.global=True
re.pattern="<script(.*?)</script>"
str=re.Replace(str,"")
re.pattern="<ifram(.*?)</ifram>"
str=re.Replace(str,"")
filterCmt=str
End function
%>