<%
%>
<%
'/非HTML代码转换函数/
Function Html2Txt(vString)
	vString = replace(vString, ">", "&gt;")
	vString = replace(vString, "<", "&lt;")
	vString = Replace(vString, CHR(32) & CHR(32) & CHR(32) & CHR(32), "&nbsp;&nbsp;&nbsp;&nbsp;")
	vString = Replace(vString, CHR(10) & CHR(10), "<br>")
	vString = Replace(vString, CHR(10), "<BR>")
	Html2Txt = vString
End Function

'/UBB代码转换函数/
'/--------------Start UBB Code--------------------------/
function UbbMl(fString)
	UbbMl = ChkString(FormatStr(ReplaceColor(ReplaceFlash(HTMLEncode(fString)))))
end function

function doCode(fString, fOTag, fCTag, fROTag, fRCTag)
	fOTagPos = Instr(1, fString, fOTag, 1)
	fCTagPos = Instr(1, fString, fCTag, 1)
	while (fCTagPos > 0 and fOTagPos > 0)
		fString = replace(fString, fOTag, fROTag, 1, 1, 1)
		fString = replace(fString, fCTag, fRCTag, 1, 1, 1)
		fOTagPos = Instr(1, fString, fOTag, 1)
		fCTagPos = Instr(1, fString, fCTag, 1)
	wend
	doCode = fString
end function

function HTMLEncode(fString)
	fString = Replace(fString, CHR(32) & CHR(32) & CHR(32) & CHR(32), "&nbsp;&nbsp;&nbsp;&nbsp;")
	fString = replace(fString, ">", "&gt;")
	fString = replace(fString, "<", "&lt;")

	HTMLEncode = fString
end function


function ChkString(fString) 
	fString = doCode(fString, "[b]", "[/b]", "<b>", "</b>")
	fString = doCode(fString, "[s]", "[/s]", "<s>", "</s>")
	fString = doCode(fString, "[strike]", "[/strike]", "<s>", "</s>")
	fString = doCode(fString, "[u]", "[/u]", "<u>", "</u>")
	fString = doCode(fString, "[i]", "[/i]", "<i>", "</i>")
	fString = doCode(fString, "[font=宋体]", "[/font=宋体]", "<font face=宋体>", "</font id=宋体>")
	fString = doCode(fString, "[font=楷体_GB2312]", "[/font=楷体_GB2312]", "<font face=楷体_GB2312>", "</font id=楷体_GB2312>")
	fString = doCode(fString, "[font=新宋体]", "[/font=新宋体]", "<font face=新宋体>", "</font id=新宋体>")
	fString = doCode(fString, "[font=黑体]", "[/font=黑体]", "<font face=黑体>", "</font id=黑体>")
	fString = doCode(fString, "[font=隶书]", "[/font=隶书]", "<font face=隶书>", "</font id=隶书>")
	fString = doCode(fString, "[font=Arial]", "[/font=Arial]", "<font face=Arial>", "</font id=Arial>")
	fString = doCode(fString, "[h1]", "[/h1]", "<h1>", "</h1>")
	fString = doCode(fString, "[h2]", "[/h2]", "<h2>", "</h2>")
	fString = doCode(fString, "[h3]", "[/h3]", "<h3>", "</h3>")
	fString = doCode(fString, "[h4]", "[/h4]", "<h4>", "</h4>")
	fString = doCode(fString, "[h5]", "[/h5]", "<h5>", "</h5>")
	fString = doCode(fString, "[h6]", "[/h6]", "<h6>", "</h6>")
	fString = doCode(fString, "[size=1]", "[/size=1]", "<font size=1>", "</font id=size1>")
	fString = doCode(fString, "[size=2]", "[/size=2]", "<font size=2>", "</font id=size2>")
	fString = doCode(fString, "[size=3]", "[/size=3]", "<font size=3>", "</font id=size3>")
	fString = doCode(fString, "[size=4]", "[/size=4]", "<font size=4>", "</font id=size4>")
	fString = doCode(fString, "[size=5]", "[/size=5]", "<font size=5>", "</font id=size5>")
	fString = doCode(fString, "[size=6]", "[/size=6]", "<font size=6>", "</font id=size6>")
	fString = doCode(fString, "[list]", "[/list]", "<ul>", "</ul>")
	fString = doCode(fString, "[list=1]", "[/list=1]", "<ol type=1>", "</ol id=1>")
	fString = doCode(fString, "[list=a]", "[/list=a]", "<ol type=a>", "</ol id=a>")
	fString = doCode(fString, "[*]", "[/*]", "<li>", "</li>")
	fString = doCode(fString, "[align=left]", "[/align]", "<div align=left>", "</div id=left>")
	fString = doCode(fString, "[align=center]", "[/align]", "<center>", "</center>")
	fString = doCode(fString, "[align=right]", "[/align]", "<div align=right>", "</div id=right>")
	fString = doCode(fString, "[code]", "[/code]", "<pre id=code><font face=courier size=" & strDefaultFontSize & " id=code>", "</font id=code></pre id=code>")
	fString = doCode(fString, "[quote]", "[/quote]", "<BLOCKQUOTE id=quote>引用：<hr size=1 noshade id=quote>", "<hr size=1 noshade id=quote></BLOCKQUOTE id=quote>")
	fString = replace(fString, "[br]", "<br>", 1, -1, 1)
	fString = doCode(fString, "[img]","[/img]","<img src="../images/"",""" border=0>")
	fString = doCode(fString, "[image]","[/image]","<img src="../images/"",""" border=0>")
	fString = doCode(fString, "[img=right]","[/img=right]","<img align=right src="../images/"",""" id=right border=0>")
	fString = doCode(fString, "[image=right]","[/image=right]","<img align=right src="../images/"",""" id=right border=0>")
	fString = doCode(fString, "[img=left]","[/img=left]","<img align=left src="../images/"",""" id=left border=0>")
	fString = doCode(fString, "[image=left]","[/image=left]","<img align=left src="../images/"",""" id=left border=0>")
	ChkString = fString
end function

function ChkUrls(fString, fTestTag, fType)

	Dim strArray
	Dim Counter
	Dim strTempString

	strTempString = fString
	if Instr(1, fString, fTestTag) > 0 then
		strArray = Split(fString, fTestTag, -1)
		strTempString = strArray(0)
		for counter = 1 to UBound(strArray)
			if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and strArray(counter)<> "") then
				strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
			elseif ((UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),11)) <> "[URL=""") and (UCase(right(strArray(counter-1),7)) <> "FILE:///") and (UCase(right(strArray(counter-1),7)) <> "HTTP://") and (UCase(right(strArray(counter-1),8)) <> "HTTPS://") and (UCase(right(strArray(counter-1),5)) <> "src="../images/"") and (UCase(right(strArray(counter-1),10)) <> "src="../images/"") and strArray(counter)<> "") then
				strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
			else
				strTempString = strTempString & fTestTag & strArray(counter)
			end if
		next
	end if

	ChkUrls = strTempString

end function

function FormatStr(fString)
	on Error resume next
	fString = Replace(fString, CHR(13), "")
	fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
	fString = Replace(fString, CHR(10), "<BR>")
	fString = ChkUrls(fString,"http://", 1)
	fString = ChkUrls(fString,"https://", 2)
	fString = ChkUrls(fString,"file:///", 3)
	fString = ChkUrls(fString,"www.", 4)
	fString = ChkUrls(fString,"mailto:",5)
	fString = ChkMail(fString," ",5)
	fString = ReplaceUrls(fString)
	FormatStr = fString
end function

Function ReplaceUrls(fString)
	Dim oTag, c1Tag, c2Tag
	Dim roTag, rc1Tag, rc2Tag
	Dim oTagPos, c1TagPos, c2TagPos
	Dim nTagPos
	Dim counter2
	Dim strArray, strArray2, strArray3

    oTag   = "[url="""
    oTag2  = "[url]"
    roTag  = "<a href="""
    c1Tag  = """]"
    c1Tag2 = "[/url]"
    rc1Tag = """ target=""_New"">"
    c2Tag  = "[/url]"
    rc2Tag = "</a>"
    oTagPos = InStr(1, fString, oTag, 1)
    c1TagPos = InStr(1, fString, c1Tag, 1)
   
	strTempString = ""
	if (oTagpos > 0) and (c1TagPos > 0) then
		strArray = Split(fString, oTag, -1)

		for counter2 = 0 to UBound(strArray)
			if (InStr(1, strArray(counter2), c2Tag, 1) > 0) and (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
				strArray2 = Split(strArray(counter2), c1Tag, -1)
				if Instr(1, strArray2(1), c2Tag) then  
					strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag)-1)
					strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag) - len(c2Tag)+1))
					if strFirstPart <> "" then
						strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
					else
						strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
					end if
				else
					strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
				end if
			elseif (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
				strArray2 = Split(strArray(counter2), c1Tag, -1)
				strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
			else
				strTempString = strTempString & strArray(counter2)
			end if
		next

	else
		strTempString = fString
	end if

	oTagPos2 = InStr(1, strTempString, oTag2, 1)
	c1TagPos2 = InStr(1, strTempString, c1Tag2, 1)

	if (oTagpos2 > 0) and (c1TagPos2 > 0) then
	 	strTempString2 = ""
	 	strArray = Split(strTempString, oTag2, -1)
	 	for counter3 = 0 to Ubound(strArray)
	 		if (Instr(1, strArray(counter3), c1Tag2) > 0) then
	 			strArray2 = split(strArray(counter3), c1Tag2, -1)
	 			strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
	 		else
	 			strTempString2 = strTempString2 & strArray(counter3)
	 		end if	
	 	next  
	 	strTempString = strTempString2
	end if

	ReplaceUrls = strTempString
End Function

Function ReplaceColor(fString)
	dim strHead,strLast,vHead,vLast,strTag
	dim vHeadString,vTempString,vLastString
	
	strHead = "[color="
	strLast = "[/color]"
	vHead = "<font color="
	vLast = "</font>"
	
	do while Instr(1,fString,strHead) > 0
		strTag = Instr(1,fString,strHead)
		vHeadString = left(fString,strTag - 1)
		vTempString = right(fString,len(fString) - strTag)
		vTempString = right(vTempString,len(vTempString) - (Instr(1,vTempString,"=")))
		vLastString = right(vTempString,len(vTempString) - (instr(1,vTempString,"]")))
		vTempString = left(vTempString,InStr(1,vTempString,"]") - 1)
		vTempString = vHead & vTempString &">"
		fString = vHeadString & vTempString & vLastString
	loop
	
	ReplaceColor = Replace(fString,"[/color]", vLast)
End Function

Function ReplaceFlash(fString)
	dim strHeadString,sqlLastString,strSecondString,strFlashPath

	do while Instr(fString,"[flash]") <> 0 And Instr(fString,"[/flash]") <> 0
		strHeadString = left(fString,Instr(fString,"[flash]") - 1)
		strLastString = right(fString,len(fString) - (Instr(fString,"[/flash]") + 7))
		strFlashPath = Right(fString,len(fString) - (Instr(fString,"[flash]") + 6))
		strFlashPath = Left(strFlashPath,Instr(strFlashPath,"[/flash]") - 1)
		fString = strHeadString &"<OBJECT classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://active.macromedia.com/flash2/cabs/swflash.cab#version=4,0,0,0"" WIDTH=""550"" HEIGHT=""400"">" &_
									"<PARAM NAME=""movie"" VALUE="""& strFlashPath &""">" &_
									"<PARAM NAME=""quality"" VALUE=""high"">" &_
									"<EMBED src="../images/""& strFlashPath &""" loop=""false"" menu=""false"" quality=""high"" WIDTH=""550"" HEIGHT=""400"" TYPE=""application/x-shockwave-flash"" PLUGINSPAGE=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"">" &_
									"</EMBED>" &_
									"</OBJECT>" & strLastString
	loop
	ReplaceFlash = fString
End Function

'/----------------------End of UBB Code----------------------------------/
%>