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

    <%
'*********************************************************
'文件名称: Ex_FilterHtmlCls.asp
'功能描述: 易心博客HTML处理类
'程序制作：易心
'官方网站: http://www.ex123.net
'论坛支持：http://bbs.ex123.net
'程序演示：http://exblog.ex123.net
'Copyright (C) 2007 ex123.net All rights reserved.
'LastUpdate:    2007-4-21
'*********************************************************
Class Ex_FilterHtmlCls
Dim re
Private Sub class_initialize
	Set re=new regexp
End Sub 
Private Sub clas_terminate
	Set re=Nothing 
End Sub 
'****************************************************
'清除html标记
'参数 str----要清除的字符串
'****************************************************
private Function cleanHtml(str)
	re.pattern="(\<)(.*?)(\>)"
	re.IgnoreCase =false
	re.Global=True
	str=re.Replace(str,"")
	cleanHtml=str
End Function
'************************************************
'判断是否存在没有闭合的标记  存在返回true 否则返回false
'参数：str 待判断的字符串
'************************************************
private function checktag(str)
	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--要处理的字符串
'**************************************************
Private function cutstr(str)
	dim i
	i=instr(str,"<")
	cutstr=left(str,i-1)
end function
'**************************************************
'把 img object embed p font br标记转化为ubb形式
'参数:str---待处理的字符串
'**************************************************
Private function html2ubb(str)
	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---待处理的字符串
'**************************************************
Private Function  ubb2html(str)
	re.ignorecase=true
	re.global=true
	re.pattern="\[img(.*?)\]"
	str=re.replace(str,"<img $1>")
	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---子字符串
'*******************************************
Private Function  checkcount(byval str,childstr)
	str=split(str,childstr)
	checkcount=ubound(str)
end function
'*******************************************
'img object embed p font标记匹配检测 清除不匹配的标记(html状态下用)
'str 要检测的字符串
'*******************************************
Private Function  checkpattern(byval str)
	dim temp,Font
	temp=str
	if checkcount(str,"<embed")<>checkcount(str,"</embed>") then
		temp=split(str,"<embed")
		str=replace(str,"<embed"&temp(ubound(temp)),"")
	end if
	if checkcount(str,"<object")<>checkcount(str,"</object>") then
		temp=split(str,"<object")
		str=replace(str,"<object"&temp(ubound(temp)),"")
	end if
	if checkcount(str,"<font")<>checkcount(str,"</font>") then
		temp=split(str,"<font")
		Font="<font"&temp(ubound(temp))
		If InStr(Font,">")<>0 And checkcount(Font,"<")=1 Then 
			str=replace(str,Font,Font&"</font>")
		Else
			Str=Replace(Str,Font,"")
		End If 
	end if
	checkpattern=str
end Function
Public Function GetHtml(ByVal str)
	str=html2ubb(str)
	if checktag(str)="True" then
		str=cutstr(str)
	end if
	str=ubb2html(str)
	GetHtml=checkpattern(str)
End Function 
End Class 
%>