修改友情链接

<%@language=vbscript codepage=936 %> <% Option Explicit Response.Buffer = True %> <% Dim EnableLinkReg Action = Trim(request("Action")) EnableLinkReg = Conn.Execute("select EnableLinkReg from PE_Config")(0) If EnableLinkReg <> True Then FoundErr = True ErrMsg = ErrMsg & "

管理员没有开放友情链接申请！

" Else If Action = "Modify" Then Call SaveModify Else Call main End If End If If FoundErr = True Then Call WriteErrMsg(ErrMsg, ComeUrl) End If Call CloseConn Sub main() Dim ID, rsLink, sqlLink ID = PE_CLng(Trim(request("ID"))) If ID = 0 Then FoundErr = True ErrMsg = ErrMsg & "

请指定友情链接ID

" Exit Sub End If sqlLink = "select * from PE_FriendSite where Passed=" & PE_True & " and ID=" & ID Set rsLink = Conn.Execute(sqlLink) If rsLink.bof And rsLink.EOF Then FoundErr = True ErrMsg = ErrMsg & "

找不到友情链接或者友情链接未审核通过！

" rsLink.Close Set rsLink = Nothing Exit Sub End If %> 修改友情链接

修改友情链接信息

所属类别：
所属专题：
网站名称：	"> *
网站地址：	" title="这里请输入您的网站地址，最多为50个字符，前面必须带http://"> *
网站Logo：	" title="这里请输入您的网站LogoUrl地址，最多为50个字符，如果您在第一选项选择的是文字链接，这项就不必填">
站长姓名：	"> *
电子邮件：	" title="这里请输入您的联系电子邮件，最多为30个字符">
原设密码：	* 必须输入
新设密码：	若不修改，请保持为空
确认密码：
网站简介：	<%=PE_ConvertBR(rsLink("SiteIntro"))%>
">

<% rsLink.Close Set rsLink = Nothing End Sub Sub SaveModify() Dim ID, KindID, SpecialID, LinkType, LinkSiteName, LinkSiteUrl, LinkLogoUrl, LinkSiteAdmin, LinkSiteEmail, OldSitePassword, LinkSitePassword, LinkSitePwdConfirm, LinkSiteIntro ID = PE_CLng(Trim(request.Form("ID"))) KindID = PE_CLng(Trim(request.Form("KindID"))) SpecialID = PE_CLng(Trim(request.Form("SpecialID"))) LinkSiteName = Trim(request("SiteName")) LinkSiteUrl = Trim(request("SiteUrl")) LinkLogoUrl = Trim(request("LogoUrl")) LinkSiteAdmin = Trim(request("SiteAdmin")) LinkSiteEmail = Trim(request("SiteEmail")) OldSitePassword = Trim(request("OldSitePassword")) LinkSitePassword = Trim(request("SitePassword")) LinkSitePwdConfirm = Trim(request("SitePwdConfirm")) LinkSiteIntro = Trim(request("SiteIntro")) If ID = 0 Then FoundErr = True ErrMsg = ErrMsg & "

不能确定友情链接ID

" End If If LinkSiteName = "" Then FoundErr = True ErrMsg = ErrMsg & "

网站名称不能为空！

" End If If LinkSiteUrl = "" Or LinkSiteUrl = "http://" Then FoundErr = True ErrMsg = ErrMsg & "

网站地址不能为空！

" End If If LinkSiteAdmin = "" Then FoundErr = True ErrMsg = ErrMsg & "

站长姓名不能为空！

" End If If LinkSiteEmail <> "" And IsValidEmail(LinkSiteEmail) = False Then FoundErr = True ErrMsg = ErrMsg & "

电子邮件地址错误！

" End If If OldSitePassword = "" Then FoundErr = True ErrMsg = ErrMsg & "

网站原设密码不能为空！

" End If If LinkSitePwdConfirm <> LinkSitePassword Then FoundErr = True ErrMsg = ErrMsg & "

新网站密码与确认密码不一致！

" End If If LinkSiteIntro = "" Then FoundErr = True ErrMsg = ErrMsg & "

网站简介不能为空！

" End If If FoundErr = True Then Exit Sub End If If LinkLogoUrl = "" Or LinkLogoUrl = "http://" Then LinkType = 2 Else LinkType = 1 End If Dim sqlLink, rsLink sqlLink = "select * from PE_FriendSite where ID=" & ID Set rsLink = Server.CreateObject("Adodb.RecordSet") rsLink.open sqlLink, Conn, 1, 3 If rsLink.bof And rsLink.EOF Then FoundErr = True ErrMsg = ErrMsg & "

找不到指定的友情链接！

" Else If md5(OldSitePassword, 16) <> rsLink("SitePassword") Then FoundErr = True ErrMsg = ErrMsg & "

你输入的旧网站密码不对，没有权限修改！

" rsLink.Close Set rsLink = Nothing Exit Sub End If rsLink("KindID") = KindID rsLink("SpecialID") = SpecialID rsLink("LinkType") = LinkType rsLink("SiteName") = ReplaceBadChar(LinkSiteName) rsLink("SiteUrl") = ReplaceUrlBadChar(LinkSiteUrl) rsLink("LogoUrl") = ReplaceUrlBadChar(LinkLogoUrl) rsLink("SiteAdmin") = PE_HTMLEncode(LinkSiteAdmin) rsLink("SiteEmail") = PE_HTMLEncode(LinkSiteEmail) If LinkSitePassword <> "" Then rsLink("SitePassword") = md5(LinkSitePassword, 16) End If rsLink("SiteIntro") = PE_HTMLEncode(LinkSiteIntro) rsLink("UpdateTime") = Now rsLink("Passed") = False rsLink.Update Call WriteSuccessMsg("修改友情链接成功！请等待管理员审核通过。", ComeUrl) Call ClearSiteCache End If rsLink.Close Set rsLink = Nothing End Sub Function GetFsKind_Option(iKindType, KindID) Dim sqlFsKind, rsFsKind, strOption strOption = "" ElseIf iKindType = 2 Then strOption = strOption & ">不属于任何专题" End If sqlFsKind = "select * from PE_FsKind" If iKindType > 0 Then sqlFsKind = sqlFsKind & " where KindType=" & iKindType End If sqlFsKind = sqlFsKind & " order by KindID" Set rsFsKind = Conn.Execute(sqlFsKind) Do While Not rsFsKind.EOF If rsFsKind("KindID") = KindID Then strOption = strOption & "" Else strOption = strOption & "" End If rsFsKind.movenext Loop rsFsKind.Close Set rsFsKind = Nothing GetFsKind_Option = strOption End Function Function ReplaceUrlBadChar(strChar) If strChar = "" Or IsNull(strChar) Then ReplaceUrlBadChar = "" Exit Function End If Dim strBadChar, arrBadChar, tempChar, i strBadChar = "+,',--,(,),<,>,[,],{,},\,;," & Chr(34) & "," & Chr(0) & "" arrBadChar = Split(strBadChar, ",") tempChar = strChar For i = 0 To UBound(arrBadChar) tempChar = Replace(tempChar, arrBadChar(i), "") Next tempChar = Replace(tempChar, "@@", "@") ReplaceUrlBadChar = tempChar End Function Function PE_HTMLEncode(ByVal fString) If IsNull(fString) Or Trim(fString) = "" Then PE_HTMLEncode = "" Exit Function End If fString = Replace(fString, ">", ">") fString = Replace(fString, "<", "<") fString = Replace(fString, Chr(32), " ") fString = Replace(fString, Chr(9), " ") fString = Replace(fString, Chr(34), """) fString = Replace(fString, Chr(39), "'") fString = Replace(fString, Chr(13), "") fString = Replace(fString, Chr(10) & Chr(10), "

") fString = Replace(fString, Chr(10), "
") PE_HTMLEncode = fString End Function '************************************************** '函数名：PE_ConvertBR '作用：将文本区域内的
替换换行 '参数：fString ---- 要处理的字符串 '返回值：处理后的字符串 '************************************************** Public Function PE_ConvertBR(ByVal fString) If IsNull(fString) Or Trim(fString) = "" Then PE_ConvertBR = "" Exit Function End If fString = Replace(fString, "

", Chr(10) & Chr(10)) fString = Replace(fString, "
", Chr(10)) fString = Replace(fString, "
", Chr(10)) PE_ConvertBR = fString End Function Sub ClearSiteCache() On Error Resume Next Dim PE_Cache Set PE_Cache = CreateObject("PE_Common6.Cache") PE_Cache.DelAllCache Set PE_Cache = Nothing End Sub %>