savegsbook.asp

有很多功能的留言版,很容易上手,有自动添加图片、表情。管理员功能也强大

<script language="vbscript" runat="server">
	'//技术支持:http://localhost/123/index.asp
	'//ReWrite on 2006-04-27 with VBScript by cash.//QQ:87256259//Email:[e-mail]
	Class savegsbook
	
		Public Request_Method
		Public Author,Open,Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,Ip,TextChange
		Public ArrFaceRs,ArrFaceRsi,FaceDefault
		Public EditContent
		Private RegEx
		
		Private Sub Class_Initialize
		Set regEx = New RegExp
			regEx.IgnoreCase = True
			regEx.Global = True
			Request_Method = ""
			Author = ""
			Open = ""
			Sex = ""
			Email = ""
			WebSize = ""
			Face = ""
			Title = ""
			Content = ""
			EditPass = ""
			EmailCall = ""
			Topic = ""
			GsBookId = ""
			Ip = ""
			EditContent = ""
		End Sub
		
		Public Sub SetRequest_Method(sRequest_Method)
			Request_Method = sRequest_Method
		End Sub
		
		Public Sub GetGsbookInfo(sAuthor,sOpen,sSex,sEmail,sWebSize,sFace,sTitle,sContent,sEditPass,sEmailCall,sTopic,sGsBookId,sIp,sTextChange)
			Author = sAuthor
			Sex = sSex
			Email = sEmail
				If Email=Empty or Email="@" Then Email="空"
			WebSize = sWebSize
				If WebSize=Empty or WebSize="http://" Then WebSize="空"
			Face = sFace
			Title = sTitle
			Content = sContent
			Open = sOpen
				If Open <> 1 Then Open = 0
			TextChange = sTextChange
				If TextChange <> 1 Then TextChange = 0
			EditPass = sEditPass
				If EditPass = Empty Then EditPass = "空"
			EmailCall = sEmailCall
				If EmailCall <> 1 Then EmailCall = 0
			Topic = sTopic
			GsBookId = sGsBookId
			Ip = sIp
		End Sub
		
		Public Sub GetFace()
			SqlStr = "Select Id,FaceName,FacePath,FaceDefault From [Face] Where Us = 1 Order By Id Desc"
			Set Rs = Conn.Execute(SqlStr)
			If Not Rs.Eof Then
				ArrFaceRsi = 1
				ArrFaceRs = Rs.GetRows
			End If	
			Rs.Close
			Set Rs = Nothing
		End Sub
		
		Public Sub getFaceDefault()
			On Error Resume Next
			FaceDefault = Conn.execute("Select FacePath From [Face] Where FaceDefault = 1 And Us = 1 Order By Add_Date desc")(0)
			If(Err.source<>"") then FaceDefault="01"
		ENd Sub
		
		Public Function CheckGsbookInfo(FiltrateWord,Author,Open,Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,ReCall,TextChange,sTextChange)'注册检查
			RegEx.Pattern = "['`<>%&.=/\*].*"
			Author = RegEx.Replace(Author,"")
			Author = Replace(Author,mid(" "" ",2,1),"&quot;") 
				If Trim(Author) = Empty Then CallErr("<li>请输入您的昵称！")
				If Len(Author)>20 Then CallErr("<li>您输入的昵称过长，请限制到20字！")
			Title = RegEx.Replace(Title,"")
			Title = Replace(Title,mid(" "" ",2,1),"&quot;") 
				If Trim(Title) = Empty Then CallErr("<li>请输入留言标题！")
				If Len(Title)>20 Then CallErr("<li>您输入的标题过长，请限制到20字！")
			If Open = 0 And EditPass = "空" Then CallErr("<li>悄悄话留言必须输入留言密码，否则你无法查看回复！<li>提示：悄悄话回复需要您提供留言密码才有权限查看。")
			If Sex<>"1" And Sex<>"0" Then CallErr("<li>请选择你的性别！")
			If Email<>"空" Then
				If Len(Email)>50 Then CallErr("<li>您输入的电子邮箱地址过长")
				If IsValidEmail(Email)=False then CallErr("<li>您输入的电子邮箱地址不正确")
			End If
			If EmailCall = 1 And ReCall <> True Then CallErr("<li>系统没有开放回复通知功能！")
			If EmailCall = 1 And Email = "空" Then CallErr("<li>您没有输入邮箱地址，不能使用回复通知功能！")
			If TextChange = 1 And sTextChange <> True Then CallErr("<li>系统已禁用字符转换功能！")
			If EditPass<>"空" Then
				If isnumeric(EditPass)=0 Then CallErr("<li>修改时的密码只限输入数字！")
				If Len(EditPass)>12 Then CallErr("<li>你输入的修改密码过长，请重新输入3-12位的密码！")
				If Len(EditPass)<3 Then CallErr("<li>你输入的修改密码过短，请重新输入3-12位的密码！")
			End If
			If WebSize<>"空" Then
				If Len(WebSize)>50 Then CallErr("<li>您输入的主页地址过长")
				If IsValidUrl(WebSize)=False then CallErr("<li>您输入的主页地址不正确")
			End If
			Dim a, m
			RegEx.Pattern = "("&FiltrateWord&")[^;\(\)]*"
			Set a = RegEx.Execute(Content&Title&Author)
				If a.Count>0 then CallErr("<li>您输入的信息包含系统限制的内容！")
				If Trim(Content) = Empty Then CallErr("<li>请输入留言内容！")
				If Len(Content)>800 Then CallErr("<li>您输入的内容过长，请限制到800字！")
		End Function
		
		Public Sub GetEditContent (sEditContent,TextChange)
			EditContent = sEditContent
			Select Case TextChange
				Case True
					Sqlstr="Select TextName,ChangePath from [TextChange] Where Us=1 order by Id"
					Set Rs=Conn.execute(Sqlstr)
					If Not Rs.Eof Then
						ArrTextRs=Rs.GetRows
					End If
					Rs.Close
					Set Rs = Nothing
					For i=0 to Ubound(ArrTextRs,2)
						EditContent = Replace(EditContent,ArrTextRs(1,i),ArrTextRs(0,i))
					Next
			End Select
				EditContent = replace(replace(replace(replace(EditContent,"&lt;","<"),"&gt;",">"),"<br>",chr(13)),"&nbsp;"," ")
				EditContent = replace(EditContent,"&quot;","'")
				EditContent = replace(EditContent,"&quot;",mid(" "" ",2,1))
		End Sub
		
		Public Sub GetContentChange (sContent,TextChange)
			Content = Ucase(sContent)
			Content = replace(replace(replace(replace(Content,"<","&lt;"),">","&gt;"),CHR(13),"<br>")," ","&nbsp;")
			Content = replace(Content,"'","&quot;")
			Content = replace(Content,mid(" "" ",2,1),"&quot;")
			If Instr(Content,"[/")>0 Then Content = LCase(Content)'//UBB支持，判断内容中是否存在“[/”，如存在则不使用英文与字符的表情转换
			Select Case TextChange
				Case 1
					Sqlstr="Select TextName,ChangePath from [TextChange] Where Us=1 order by Id"
					Set Rs=Conn.execute(Sqlstr)
					If Not Rs.Eof Then
						ArrTextRs=Rs.GetRows
					End If
					Rs.Close
					Set Rs = Nothing
					For i=0 to Ubound(ArrTextRs,2)
						Content = Replace(Content,ArrTextRs(0,i),ArrTextRs(1,i))
					Next
			End Select
		End Sub
		
		Public Sub SetWithHtml (WithHtml,sContent)
			If WithHtml = 1 Then
				Content = sContent
			Else
				Content = sContent
				Content = replace(replace(replace(replace(Content,"<","&lt;"),">","&gt;"),CHR(13),"<br>")," ","&nbsp;")
				Content = replace(Content,"'","&quot;")
				Content = replace(Content,mid(" "" ",2,1),"&quot;")
			End If
		End Sub
		
		Public Function UpdateGsBook (Author,Open,Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,Ip,TextChange)
			Conn.Execute("Insert Into [GsbookDate] (Author,[Open],Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,Ip,TextChange) Values ('"&Author&"','"&Open&"','"&Sex&"','"&Email&"','"&WebSize&"','"&Face&"','"&Title&"','"&Content&"','"&EditPass&"','"&EmailCall&"','"&Topic&"','"&GsBookId&"','"&Ip&"','"&TextChange&"')")
			Response.Cookies("sContent") = Left(Content,12)&Right(Content,8)
			Response.Cookies("Author") = Author
		End Function
		
		Public Function UpdateRe (Author,Open,Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,Ip,Re)
			If Re = True Then'//已存在回复
				If Conn.Execute("Select Id From [GsbookDate] Where GsBookId="&GsBookId).Eof Then
					Conn.Execute("Update [GsbookDate] set Re=0 Where Id="&GsBookId)
					Response.write "回复参数错误，请重新输入！"
				Else
					Id = Conn.Execute("Select Id From [GsbookDate] Where GsBookId="&GsBookId)(0)
					Conn.Execute("Update [GsbookDate] set Title='"&Title&"',Content='"&Content&"',Re_date='"&Now()&"' Where Id="&Id)
				End If
			Else
				Conn.Execute("Insert Into [GsbookDate] (Author,[Open],Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Topic,GsBookId,Ip) Values ('"&Author&"','"&Open&"','"&Sex&"','"&Email&"','"&WebSize&"','"&Face&"','"&Title&"','"&Content&"','"&EditPass&"','"&EmailCall&"','"&Topic&"','"&GsBookId&"','"&Ip&"')")
				Conn.Execute("Update [GsbookDate] set Re_date='"&Now()&"',Re=1 Where Id="&GsBookId)
			End If
		End Function
		
		Public Function SaveEdit (loginok,Re,Author,Open,Sex,Email,WebSize,Face,Title,Content,EditPass,EmailCall,Id,sOpen,sAuthor,sSex,sEmail,sWebSize,sFace,sTitle,scontent,sEditPass,sEmailCall,TextChange,sTextChange)
			If loginok = 0 And Re = True Then CallErr("<li>该留言已存在回复，您没有权限修改！")
			If Author<>sAuthor Then Conn.execute("Update [GsbookDate] Set Author='"&Author&"' Where Id="&Id)
			If Open<>sOpen Then Conn.execute("Update [GsbookDate] Set [Open]='"&Open&"' Where Id="&Id)
			If Sex<>sSex Then Conn.execute("Update [GsbookDate] Set Sex='"&Sex&"' Where Id="&Id)
			If Email<>sEmail Then Conn.execute("Update [GsbookDate] Set Email='"&Email&"' Where Id="&Id)
			If WebSize<>sWebSize Then Conn.execute("Update [GsbookDate] Set WebSize='"&WebSize&"' Where Id="&Id)
			If Face<>sFace Then Conn.execute("Update [GsbookDate] Set Face='"&Face&"' Where Id="&Id)
			If Title<>sTitle Then Conn.execute("Update [GsbookDate] Set Title='"&Title&"' Where Id="&Id)
			If Content<>sContent Then Conn.execute("Update [GsbookDate] Set Content='"&Content&"' Where Id="&Id)
			If EditPass<>sEditPass Then Conn.execute("Update [GsbookDate] Set EditPass='"&EditPass&"' Where Id="&Id)
			If sEmailCall = True Then sEmailCall = 1 Else sEmailCall = 0
			If EmailCall<>sEmailCall Then Conn.execute("Update [GsbookDate] Set EmailCall='"&EmailCall&"' Where Id="&Id)
			If sTextChange = True Then sTextChange = 1 Else sTextChange = 0
			If TextChange<>sTextChange Then Conn.execute("Update [GsbookDate] Set TextChange='"&TextChange&"' Where Id="&Id)
		End Function
		
		Public Function SaveDel(loginok,Id,Re)
			If loginok = 0 And Re = True Then CallErr("<li>该留言已存在回复，你没有权限删除！") 
			Conn.Execute("Delete From [GsbookDate] Where Id="&Id)
			If Re = True Then  Conn.Execute("Delete From [GsbookDate] Where GsbookId="&Id)
		End Function
		
		Public Function SaveDelRe(GsbookId,Id)
			Conn.Execute("Delete From [GsbookDate] Where Id="&Id)
			Conn.Execute("Update [GsbookDate] Set Re=0 Where Id="&GsbookId)
		End Function
		
		Public Function SaveOntop(Ontop,Id)
			If Ontop = True Then Ontop = 0 Else Ontop = 1
			Conn.Execute("Update [GsbookDate] Set Ontop='"&Ontop&"' Where Id="&Id)
		End Function
		
		Public Function CheckSave (sContent,Content)
			iContent = Left(Content,12)&Right(Content,8)
			If sContent = iContent Then CallErr("<li>请勿重复提交留言，谢谢合作！")
		End Function
	End Class
	
</script>