function.asp

我见过的用ASP写的最好的留言簿程序

<%
function change(strContent)
strContent = HTMLEncode(strContent)
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
strContent=re.Replace(strContent,"&#106avascript")
re.Pattern="(jscript:)"
strContent=re.Replace(strContent,"&#106script:")
re.Pattern="(js:)"
strContent=re.Replace(strContent,"&#106s:")
re.Pattern="(value)"
strContent=re.Replace(strContent,"&#118alue")
re.Pattern="(about:)"
strContent=re.Replace(strContent,"about&#58")
re.Pattern="(file:)"
strContent=re.Replace(strContent,"file&#58")
re.Pattern="(document.cookie)"
strContent=re.Replace(strContent,"documents&#46cookie")
re.Pattern="(vbscript:)"
strContent=re.Replace(strContent,"&#118bscript:")
re.Pattern="(vbs:)"
strContent=re.Replace(strContent,"&#118bs:")
re.Pattern="(on(mouse|exit|error|click|key))"
strContent=re.Replace(strContent,"&#111n$2")

re.Pattern="(\[URL\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=images/u_14.gif border=0><A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=images/u_14.gif border=0><A HREF=""$2"" TARGET=_blank>$3</A>")

re.Pattern="(\[EMAIL\])(.[^\]]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=images/u_13.gif border=0><A HREF=""mailto:$2"">$2</A>")
re.Pattern="(\[EMAIL=(.[^\]]*)\])(.[^\]]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<img align=absmiddle src=images/u_13.gif.gif border=0><A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

re.Pattern="(\[center\])(.[^\[]*)(\[\/center\])"
strContent=re.Replace(strContent,"<p align=center>$2")

re.Pattern="\[light\](.[^\[]*)\[\/light]"
strContent=re.replace(strContent,"<span style=""behavior:url(images/font.htc)"">$1</span>")
re.Pattern="\[fly\](.+?)\[\/fly\]"
strContent=re.replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
re.Pattern="\[move\](.+?)\[\/move\]"
strContent=re.replace(strContent,"<MARQUEE scrollamount=3>$1</marquee>")	
re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:shadow(color=$2, strength=$3)"">$4</td></tr></table>")

re.Pattern="(\[i\])(.[^\[]*)(\[\/i\])"
strContent=re.Replace(strContent,"<i>$2</i>")
re.Pattern="(\[u\])(.[^\[]*)(\[\/u\])"
strContent=re.Replace(strContent,"<u>$2</u>")
re.Pattern="(\[b\])(.[^\[]*)(\[\/b\])"
strContent=re.Replace(strContent,"<b>$2</b>")

re.Pattern="(\[pic(.[^\]]*)\])"
strContent=re.Replace(strContent,"<img src=images/faces/$2.gif border=0 align=textop>")

re.Pattern="\[Ra\](.[^\[]*)\[\/Ra]"
strContent=re.replace(strContent,"此文章相关的 RealPlayer 音乐如下：[ <a href=$1>(点这里下载)</a> ]<br><object classid=clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=280 height=70><param name=_ExtentX value=7938><param name=_ExtentY value=2646><param name=AUTOSTART value=0><param name=SHUFFLE value=0><param name=PREFETCH value=0><param name=NOLABELS value=0><param name=LOOP value=0><param name=NUMLOOP value=0><param name=CENTER value=0><param name=MAINTAINASPECT value=0><param name=BACKGROUNDCOLOR value=#000000><PARAM NAME=SRC VALUE=$1></object>")

re.pattern="\[IMG\](http|https|ftp):\/\/(.[^\[]*)\[\/IMG\]"
strContent=re.replace(strContent,"<img src=$1://$2 border=0 width=120 height=50 style='cursor:hand' alt=按此在新窗口浏览图片  onclick=""window.open(this.src,null,'')"">")

re.pattern="(\[sound\])(.[^\[]*)(\[\/sound\])" 
strContent=re.Replace(strContent,"<a href=""$2"" target=_blank><IMG SRC=images/mid.gif border=0 alt='背景音乐'></a><bgsound src=""$2"" loop=""-1"">")

re.Pattern="\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]"
strContent=re.Replace(strContent,"<br>此文章相关媒体如下：<a href=""$3"" TARGET=_blank>(点这里下载)</a><br><object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 >" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=0><param name=ShowStatusBar value=-1>" & vbcrlf & "<param name=Filename value=$3>" & vbcrlf & "<embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3 width=$1 height=$2>" & vbcrlf & "</embed>" & vbcrlf & "</object>")
re.Pattern="\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]"
strContent=re.Replace(strContent,"此主题相关媒体如下：<a href=""$3"" TARGET=_blank>(点这里下载)</a><br><OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=imagewindow>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=false>" & vbcrlf & "</OBJECT>" & vbcrlf & "<br>" & vbcrlf & "<OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=0>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=controlpanel>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "</OBJECT>")

set re=Nothing
change=strContent
end function

Sub info
	Sql="Select * From admin where id=1"
	Set Rs=Conn.Execute(SQL)
If rs.eof and rs.bof then
	Response.Redirect "error.asp"
	Response.End
End If
End Sub

Function ChkPost
	Dim Server_V1,Server_V2
	ChkPost=False
	Server_V1=Cstr(Request.ServerVariables("HTTP_REFERER"))
	Server_V2=Cstr(Request.ServerVariables("SERVER_NAME"))
	If Mid(Server_V1,8,Len(Server_V2))<>Server_V2 Then
		ChkPost=False
	Else
		ChkPost=True
	End If
End Function

Function check_name(str)
check_name=true
if Instr(str,"=")>0  or Instr(str,"%")>0 or Instr(str,chr(32))>0  or Instr(str,"?")>0 or Instr(str,"&")>0 or Instr(str,";")>0 or Instr(str,",")>0  or Instr(str,"'")>0 or Instr(str,".")>0 or Instr(str,chr(34))>0 or Instr(str,chr(9))>0  or Instr(str,"