ubblist.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

<%
Function Ubblist(Str1)
	Dim Str
	Str=Str1
	Str=LCase(Str)
	Dim Dv_ubb(54),i
	Dv_ubb(0)="javascript":Dv_ubb(1)="jscript:":Dv_ubb(2)="js:":Dv_ubb(3)="value":Dv_ubb(4)="about:"
	Dv_ubb(5)="file:":Dv_ubb(6)="document.cookie":Dv_ubb(7)="vbscript:":Dv_ubb(8)="vbs:":Dv_ubb(9)="mouse"
	Dv_ubb(10)="exit":Dv_ubb(11)="error":Dv_ubb(12)="click":Dv_ubb(13)="key":Dv_ubb(14)="[/img]"
	Dv_ubb(15)="[/upload]":Dv_ubb(16)="[/dir]":Dv_ubb(17)="[/qt]":Dv_ubb(18)="[/mp]":Dv_ubb(19)="[/rm]"
	Dv_ubb(20)="[/sound]":Dv_ubb(21)="[/flash]":Dv_ubb(22)="[/money]":Dv_ubb(23)="[/point]":Dv_ubb(24)="[/usercp]"
	Dv_ubb(25)="[/power]":Dv_ubb(26)="[/post]":Dv_ubb(27)="[/replyview]":Dv_ubb(28)="[/usemoney]":Dv_ubb(29)="[/url]"
	Dv_ubb(30)="[/email]":Dv_ubb(31)="http":Dv_ubb(32)="https":Dv_ubb(33)="ftp":Dv_ubb(34)="rtsp":Dv_ubb(35)="mms"
	Dv_ubb(36)="[/html]":Dv_ubb(37)="[/code]":Dv_ubb(38)="[/color]":Dv_ubb(39)="[/face]":Dv_ubb(40)="[/align]"
	Dv_ubb(41)="[/quote]":Dv_ubb(42)="[/fly]":Dv_ubb(43)="[/move]":Dv_ubb(44)="[/shadow]":Dv_ubb(45)="[/glow]"
	Dv_ubb(46)="[/size]":Dv_ubb(47)="[/i]":Dv_ubb(48)="[/b]":Dv_ubb(49)="[/u]":Dv_ubb(50)="[em":Dv_ubb(51)="www.":Dv_ubb(52)="[/payto]"
	Dv_ubb(53)="[/username]":Dv_ubb(54)="[/center]"
	Ubblist=","
	'检查脚本标记0
	For i=0 to 13
		If InStr(Str,Dv_ubb(i))>0 Or InStr(Str,"&#")>0  or InStr(Str,"button") Then
				Ubblist=Ubblist&"0,"
			Exit For
		End If
	Next
	'Response.Write "Ubblist:<br>"
	For i=14 to 54
		If InStr(Str,Dv_ubb(i))>0 Then
			If i >= 52 Then
				Ubblist=Ubblist & i-12 &","
			Else
				Ubblist=Ubblist & i-13 &","
			End If
		End If
		'Response.Write Dv_ubb(i)&"编号:"&i-13&"."		
	Next
	Ubblist=Ubblist & "39,"
	If istext(Str1) Then
		Ubblist=Ubblist&"istext,"
	End If
	If xhtml(Str1) Then
		Ubblist=Ubblist&"xhtml,"
		Exit Function
	End If
	
	Dim TmpStr
	'去掉字符串中的空格
	If IsNull(Str) Then Exit Function
	TmpStr=Replace(Str," ","")
	TmpStr=Replace(TmpStr,"  ","")
	TmpStr=Replace(TmpStr,Chr(10),"")
	TmpStr=Replace(TmpStr,Chr(13),"")
	'Ubblist=Ubblist&fixtable(TmpStr,"table")'&fixtable(TmpStr,"td")&fixtable(TmpStr,"th")&fixtable(TmpStr,"tr")
	Ubblist=Ubblist&checkTable(TmpStr)
End Function
Function istext(Str)
	Dim text,text1
	text=Str
	text1=Str
 If text1=Dvbbs.Replacehtml(text) Then
 	istext=True
 End If
End Function
'检查表格
Function fixtable(Str,flag)
	Dim bodyStr
	bodyStr=Str
	If bodyStr<>"" Then
		Dim instr1,instr2
		Dim Str1,Str2,newstr1,newstr2
		Str2="</"&flag&">"
		Str1="<"&flag
		Instr1=InStr(bodyStr,str1)
		Instr2=InStr(bodyStr,Str2)
		If Instr1 >0 And Instr2>0 Then
			If Instr1 > Instr2 Then
				fixtable=flag&","
				Exit Function
			Else
				newstr1=Mid(bodyStr,InStr2+Len(Str2),Len(bodyStr)-(instr2+Len(Str2)-instr1))
				Newstr2=Mid(bodyStr,InStr1+Len(Str1),instr2-instr1-Len(str2)+2)												
				fixtable=fixtable(newstr1,flag)&fixtable(newstr2,flag)
			End If
		ElseIf Instr1 =0 And Instr2=0 Then
			Exit Function
		ElseIf Instr1 >0 And Instr2=0 Then
			fixtable=flag&","
			Exit Function
		ElseIf Instr1 =0 And Instr2>0 Then
			fixtable=flag&","
			Exit Function
		End If
	Else
		fixtable=""
	End If
End Function
Function UbblistOLD(Str)
	UbblistOLD=Ubblist(Str)
	UbblistOLD=Replace(UbblistOLD,"39,","")
End Function
Function checkTable(tablestr)
	checkTable=""
	Dim s,tmpstr1,tmpstr2
	s=tablestr
	tmpstr1=split(s,"<table")
	tmpstr2=split(s,"</table>")
	If UBound(tmpstr1)<>UBound(tmpstr2) Then
		checkTable=checkTable&"table,"
	End If
	tmpstr1=split(s,"<td")
	tmpstr2=split(s,"</td>")
	If UBound(tmpstr1)<>UBound(tmpstr2) Then
		checkTable=checkTable&"td,"
	End If
	tmpstr1=split(s,"<div")
	tmpstr2=split(s,"</div>")
	If UBound(tmpstr1)<>UBound(tmpstr2) Then
		checkTable=checkTable&"tr,"
	End If
	tmpstr1=split(s,"<th")
	tmpstr2=split(s,"</th>")
	If UBound(tmpstr1)<>UBound(tmpstr2) Then
		checkTable=checkTable&"th,"
	End If
End Function

Function CheckAlipay()
	Dim seller,subject,price,transport,mail,express,demo,ww,qq,message,api_key
	seller = Request.Form("alipay_seller")
	subject = Request.Form("alipay_subject")
	message = Request.Form("body")
	price = Request.Form("alipay_price")
	transport = Request.Form("ialipay_transport")
	mail = Request.Form("alipay_mail")
	express = Request.Form("alipay_express")
	demo = Request.Form("alipay_demo")
	ww = Request.Form("alipay_ww")
	qq = Request.Form("alipay_qq")
	'api_key = Request.Form("alipay_key")
	If seller = "@" Or seller = "" Or subject = "" Or (Not IsNumeric(price)) Or message = "" Then
		CheckAlipay = ""
		Exit Function
	End If
	CheckAlipay = "[payto]"
	CheckAlipay = CheckAlipay & "(seller)"&seller&"(/seller)"
	CheckAlipay = CheckAlipay & "(subject)"&subject&"(/subject)"
	CheckAlipay = CheckAlipay & "(body)"&message&"(/body)"
	CheckAlipay = CheckAlipay & "(price)"&price&"(/price)"
	CheckAlipay = CheckAlipay & "(transport)"&transport&"(/transport)"
	If mail <> "" And IsNumeric(mail) Then CheckAlipay = CheckAlipay & "(ordinary_fee)"&mail&"(/ordinary_fee)"
	If express <> "" And IsNumeric(express) Then CheckAlipay = CheckAlipay & "(express_fee)"&express&"(/express_fee)"
	If demo <> "" And Not Lcase(demo) = "http://" Then CheckAlipay = CheckAlipay & "(demo)"&demo&"(/demo)"
	If ww <> "" Then CheckAlipay = CheckAlipay & "(ww)"&ww&"(/ww)"
	If qq <> "" Then CheckAlipay = CheckAlipay & "(qq)"&qq&"(/qq)"
	'If api_key<>"" Then  CheckAlipay = CheckAlipay & "(key)"&api_key&"(/key)"
	CheckAlipay = CheckAlipay & "[/payto]"
	CheckAlipay = Dvbbs.CheckStr(CheckAlipay)
End Function
Function xhtml(Str)
	Dim xml
	Set xml=Server.CreateObject("msxml2.DOMDocument"& MsxmlVersion)
	xhtml= xml.loadxml("<xml>" & xmlencode(Str) &"</xml>") 
End Function
Function xmlencode(Str)
		Dim s,i
		s=Str
		S=replace(S,"&","&amp;")
		For i=0 to 31
			S=Replace(S,Chr(i),"&amp;#"&i&";")
		Next
		For i=95 to 96
			S=Replace(S,Chr(i),"&amp;#"&i&";")
		Next
		xmlencode=S
	End Function
Function Rexmlencode(Str)
	Dim i
	Str=replace(Str,"&amp;","&")
	For i=0 to 31
		Str=Replace(Str,"&#"&i&";",Chr(i))
	Next
	For i=95 to 96
			Str=Replace(Str,"&#"&i&";",Chr(i))
		Next
	Rexmlencode=Str
End Function
%>