savesys.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 SaveSys
	
		Public Request_Method
		Public Web_name,Web_Url,AdminUser,AdminPass,AdminPass2,Email,FiltrateWord,EmailCall,OpenReCall,OpenWrite,OpenRead,OpenEdit,OpenGsbook,WebAdvertise,TextChange
		Public MailIObj,PassWord,Smtp,SendName,Title,GsbookUrl,SetMail
		Public Ip,Author,ShowIp,ArrRs
		Public ShowChange,TextType,TextName,file,FileName,FilePath,ArriRs,Id,PostType,ImgEdit,TxtEdit
		Public ShowFace,FaceName,MakeName
		Private regEx
		
		Private Sub Class_Initialize
		Set regEx = New RegExp
			regEx.IgnoreCase = True
			regEx.Global = True
			Request_Method = ""

		End Sub
		
		Public Sub SetRequest_Method(sRequest_Method)
			Request_Method = sRequest_Method
		End Sub
		
		Public Sub GetSys_WebInfo(sWeb_name,sWeb_Url,sAdminUser,sAdminPass,sAdminPass2,sEmail,sFiltrateWord,sEmailCall,sOpenReCall,sOpenWrite,sOpenRead,sOpenEdit,sOpenGsbook,sWebAdvertise,sTextChange)
			Web_name = sWeb_name
			Web_Url = sWeb_Url
			AdminUser = sAdminUser
			AdminPass = sAdminPass
			AdminPass2 = sAdminPass2
			Email = sEmail
			FiltrateWord = sFiltrateWord
			WebAdvertise = sWebAdvertise
			TextChange = STextChange
				If TextChange = Empty Then TextChange = 0
			OpenGsbook = sOpenGsbook
				If OpenGsbook = Empty Then OpenGsbook = 0
			EmailCall = sEmailCall
				If EmailCall = Empty Then EmailCall = 0
			OpenReCall = sOpenReCall
				If OpenReCall = Empty Then OpenReCall = 0
			OpenWrite = sOpenWrite
				If OpenWrite = Empty Then OpenWrite = 0
			OpenRead = sOpenRead
				If OpenRead = Empty Then OpenRead = 0
			OpenEdit = sOpenEdit
				If OpenEdit = Empty Then OpenEdit = 0
		End Sub
		
		Public Function CheckSys_WebInfo(Web_name,Web_Url,AdminUser,AdminPass,AdminPass2,Email,FiltrateWord,OpenGsbook,WebAdvertise)
			
			If Trim(Web_name) = Empty Or Len(Web_name)>20 Then CallErr("<Li>您没有输入的网站名称或输入的长度大于20")
			If Trim(Web_Url) = Empty Or Len(Web_Url)>100 Then CallErr("<Li>您没有输入的网站地址或输入的长度大于100")
			If IsValidUrl(Web_Url)=False then CallErr("<li>您输入的网站地址不正确")
			If Trim(AdminUser) = Empty Or Len(AdminUser)>20 Then CallErr("<Li>您没有输入的管理员或输入的长度大于20")
				RegEx.Pattern = "['`<>%&.=/\*].*"
				AdminUserx = RegEx.Replace(AdminUser,"")
				AdminUserx = Replace(AdminUserx,mid(" "" ",2,1),"&quot;") 
				If AdminUserx <> AdminUser Then CallErr("<Li>您输入的管理员名字含有系统限制的字符")
			If Trim(AdminPass) = Empty Or Len(AdminPass)>12 Or Len(AdminPass)<6 Then CallErr("<Li>您没有输入的管理密码或输入的长度超出6-12位")
				AdminPassx = RegEx.Replace(AdminPass,"")
				AdminPassx = Replace(AdminPassx,mid(" "" ",2,1),"") 
				If AdminPassx <> AdminPass Then CallErr("<Li>您输入的管理密码含有系统限制的字符")
			If AdminPass2 <> Empty Then
				If AdminPass <> AdminPass2 Then CallErr("<Li>您输入的确认密码与第一次输入的不相同，请重新输入！")
			End If
			If Email = Empty Or Len(Email) > 100 Then CallErr("<li>您没有输入邮箱地址或长度大于100")
			If IsValidEmail(Email)=False then CallErr("<li>您输入的电子邮箱地址不正确")
			If Len(FiltrateWord) > 200 Then CallErr("<li>您输入的过滤关键字内容过长")
			If OpenGsbook = 0 Then
				If Trim(WebAdvertise) = Empty Then  CallErr("<li>你选择了临时关闭留言板，请输入临时公告")
				If Len(WebAdvertise) > 200 Then  CallErr("<li>你输入的公告过长，请限制到200字以内")
			End If
		End Function
		
		Public Function UpdateSys_Web(Web_name,Web_Url,AdminUser,AdminPass,AdminPass2,Email,FiltrateWord,EmailCall,OpenReCall,OpenWrite,OpenRead,OpenEdit,OpenGsbook,WebAdvertise,sWeb_name,sWeb_Url,sAdminUser,sAdminPass,sEmail,sFiltrateWord,sEmailCall,sOpenReCall,sOpenWrite,sOpenRead,sOpenEdit,sOpenGsbook,sWebAdvertise,TextChange,sTextChange)
			If Web_name <> sWeb_name Then Conn.Execute("Update [SysTem] Set Web_name = '"&Web_name&"'")
			If Web_Url <> sWeb_Url Then Conn.Execute("Update [SysTem] Set Web_Url = '"&Web_Url&"'")
			If Email <> sEmail Then Conn.Execute("Update [SysTem] Set Email = '"&Email&"'")
			If FiltrateWord <> sFiltrateWord Then Conn.Execute("Update [SysTem] Set FiltrateWord = '"&FiltrateWord&"'")
			If WebAdvertise <> sWebAdvertise Then Conn.Execute("Update [SysTem] Set WebAdvertise = '"&WebAdvertise&"'")
			If sTextChange = True Then sTextChange = 1 Else sTextChange = 0
				If TextChange <> sTextChange Then Conn.Execute("Update [SysTem] Set OpenChange = '"&TextChange&"'")
			If sOpenGsbook = True Then sOpenGsbook = 1 Else sOpenGsbook = 0
				If OpenGsbook <> sOpenGsbook Then Conn.Execute("Update [SysTem] Set OpenGsbook = '"&OpenGsbook&"'")
			If sEmailCall = True Then sEmailCall = 1 Else sEmailCall = 0
				If EmailCall <> sEmailCall Then Conn.Execute("Update [SysTem] Set EmailCall = '"&EmailCall&"'")
			If sOpenReCall = True Then sOpenReCall = 1 Else sOpenReCall = 0
				If OpenReCall <> sOpenReCall Then Conn.Execute("Update [SysTem] Set OpenReCall = '"&OpenReCall&"'")
			If sOpenWrite = True Then sOpenWrite = 1 Else sOpenWrite = 0
				If OpenWrite <> sOpenWrite Then Conn.Execute("Update [SysTem] Set OpenWrite = '"&OpenWrite&"'")
			If sOpenRead = True Then sOpenRead = 1 Else sOpenRead = 0
				If OpenRead <> sOpenRead Then Conn.Execute("Update [SysTem] Set OpenRead = '"&OpenRead&"'")
			If sOpenEdit = True Then sOpenEdit = 1 Else sOpenEdit = 0
				If OpenEdit <> sOpenEdit Then Conn.Execute("Update [SysTem] Set OpenEdit = '"&OpenEdit&"'")
			If AdminUser <> sAdminUser Then Conn.Execute("Update [SysTem] Set AdminUser = '"&AdminUser&"'")
			If AdminPass <> sAdminPass And AdminPass2 = Empty Then CallErr("<Li>你输入的密码与原密码不一致！<li>如果需要更改密码，请填写确认密码选项！")
			If AdminPass2 <> Empty And AdminPass<>sAdminPass Then Conn.Execute("Update [SysTem] Set AdminPass = '"&AdminPass&"'")
			'If AdminUser <> sAdminUser Then CallErr("<Li>你的管理员用户名已成功修改，请重新登陆！")
			'If AdminPass2 <> Empty And AdminPass<>sAdminPass Then CallErr("<Li>你的管理密码已成功修改，请重新登陆！")
		End Function
	
		Public Sub GetSys_MailInfo(sMailIObj,sEmail,sPassWord,sSmtp,sSendName,sTitle,sGsbookUrl)
			MailIObj = sMailIObj
				If MailIObj = "No" Or MailIObj = Empty Then
					SetMail = 0
				Else
					SetMail = 1
				End If
			Email = sEmail
			PassWord = sPassWord
			Smtp = sSmtp
			SendName = sSendName
			Title = sTitle
			GsbookUrl = sGsbookUrl
		End Sub
		
		Public Function CheckSys_MailInfo(MailIObj,Email,PassWord,Smtp,SendName,Title,GsbookUrl)
			If Email = Empty Or Len(Email) > 100 Then CallErr("<li>您没有输入邮箱地址或长度大于100")
			If IsValidEmail(Email)=False then CallErr("<li>您输入的电子邮箱地址不正确")
			If Trim(Title) = Empty Or Len(Email) > 50 Then CallErr("<li>您没有输入邮箱标题或长度大于50")
			If Trim(GsbookUrl) = Empty Or Len(GsbookUrl) > 100 Then CallErr("<li>您没有输入留言本地址或长度大于100")
			Select Case MailIObj
				Case "Jmail"
					If Trim(PassWord) = Empty Or Len(PassWord) > 20 Then CallErr("<li>你所选用的是JMAIL发信组件，请填写邮箱密码！")
					If Trim(Smtp) = Empty Or Len(Smtp) > 20 Then CallErr("<li>你所选用的是JMAIL发信组件，请填写邮箱SMTP地址！")
					If Trim(SendName) = Empty Or Len(SendName) > 20 Then CallErr("<li>你所选用的是JMAIL发信组件，请填写邮箱发信人名字！")
			End Select
		End Function
		
		Public Function UpdateSys_Mail (MailIObj,Email,PassWord,Smtp,SendName,Title,GsbookUrl,sMailIObj,sEmail,sPassWord,sSmtp,sSendName,sTitle,sGsbookUrl)
			If MailIObj <> sMailIObj Then
				Conn.ExeCute("Update [MailConfig] Set Use=0")
				Conn.ExeCute("Update [MailConfig] Set Use=1 Where MailIObj='"&MailIObj&"'")
			End If
			If Email <> sEmail Then Conn.ExeCute("Update [MailConfig] Set Email='"&Email&"' Where MailIObj='"&MailIObj&"'")
			If PassWord <> sPassWord Then Conn.ExeCute("Update [MailConfig] Set [PassWord]='"&PassWord&"' Where MailIObj='"&MailIObj&"'")
			If Smtp <> sSmtp Then Conn.ExeCute("Update [MailConfig] Set Smtp='"&Smtp&"' Where MailIObj='"&MailIObj&"'")
			If SendName <> sSendName Then Conn.ExeCute("Update [MailConfig] Set SendName='"&SendName&"' Where MailIObj='"&MailIObj&"'")
			If Title <> sTitle Then Conn.ExeCute("Update [MailConfig] Set Title='"&Title&"' Where MailIObj='"&MailIObj&"'")
			If GsbookUrl <> sGsbookUrl Then Conn.ExeCute("Update [MailConfig] Set GsbookUrl='"&GsbookUrl&"' Where MailIObj='"&MailIObj&"'")
		End Function
		
		Public Function DelSys_Mail()
			Conn.ExeCute("Update [MailConfig] Set Use=0")
		End Function
		
		Public Sub GetSys_GetLockIpInfo(sIp,sAuthor)
			Ip = sIp
			Author = sAuthor
				If Trim(Author) = Empty Then Author = "未知"
		End Sub
		
		Public Function GetSys_CheckLockIpInfo(Ip,Author)
			sIp = Replace(Ip,".","")
			If  sIp=empty Or isnumeric(sIp)=0 or Len(Ip)<7 or Len(Ip)>15 or sIp=Ip Then CallErr("<Li>你没有输入需要锁定的IP或输入的IP格式不正确")
			If Len(Author)>20 Then CallErr("<Li>你输入的留言名字超过20字！")
		End Function
		
		Public Function UpdateSys_LockIp(Ip,Author)
			If Not Conn.Execute("Select Id From [LockIp] Where Ip='"&Ip&"'").Eof Then CallErr("<Li>该IP已锁定，无须重复操作！")
			Conn.Execute("Insert Into [LockIp] (Ip,Author) Values ('"&Ip&"','"&Author&"')")
		End Function
		
		Public Sub DelSys_LockIp(sId)
			If sId=empty Or isnumeric(sId)=0 Then CallErr("<Li>解除IP锁定参数错误！")
			If Conn.Execute("Select Id From [LockIp] Where Id="&sId).Eof Then CallErr("<Li>操作失败，不存在此IP锁定！")
			Conn.Execute("Delete From [LockIp] Where Id="&sId)
		End Sub
		
		Public Sub GetSys_LockIp()
			SqlStr = "Select Id,Ip,Author,GsBookId,Add_date From [LockIp] Order By Id Desc"
			Set Rs = Conn.execute(SqlStr)
			If Not Rs.eof Then
				ShowIp = 1
				ArrRs=Rs.getrows
			End If
			Rs.close
			Set Rs=Nothing
		End Sub
		
		Public Sub GetSys_Change()
			SqlStr = "Select Id,TextName,ChangePath,Us,Add_date From [TextChange] Order By Id Desc"
			Set Rs = Conn.execute(SqlStr)
			If Not Rs.eof Then
				ShowChange = 1
				ArrRs=Rs.getrows
			End If
			Rs.close
			Set Rs=Nothing
		End Sub
		
		Public Sub DelSys_Change (sId)
			If sId=empty Or isnumeric(sId)=0 Then CallErr("<Li>删除参数错误！")
			If Conn.Execute("Select Id From [TextChange] Where Id="&sId).Eof Then CallErr("<Li>操作失败，不存在该表情！")
			Conn.Execute("Delete From [TextChange] Where Id="&sId)
		End Sub
		
		Public Sub UsSys_Change (sId)
			If sId=empty Or isnumeric(sId)=0 Then CallErr("<Li>启用/解除参数错误！")
			If Conn.Execute("Select Id From [TextChange] Where Id="&sId).Eof Then CallErr("<Li>操作失败，不存在该表情！")
			Us = Conn.Execute("Select Us From [TextChange] Where Id="&sId)(0)
			If Us = True Then Us = 0 Else Us = 1
			Conn.Execute("Update [TextChange] set Us = '"&Us&"' Where Id="&sId)
		End Sub
		
		Public Sub GetSys_GetChangeInfo(sTextType,sTextName,sFile,sType)
			TextType = sTextType
			TextName = sTextName
			Set file = sFile
			PostType = sType
		End Sub
		
		Public Sub GetSys_GetFileInfo(file,TextType)
			
			FileName = file.FileName
			 Dim i, n
			 For i = 1 to 6
				Randomize
				n = Int(Rnd()*(9-0+1)+0)
				MakeName = MakeName & n