<%@language=vbscript codepage=936 %> <% option explicit response.buffer=true Const PurviewLevel=2 Const CheckChannelID=0 Const PurviewLevel_Others="FriendSite" %> <% dim strFileName const MaxPerPage=20 dim totalPut,CurrentPage,TotalPages dim sql,rs,ID,LinkType dim Action,FoundErr,ErrMsg Action=trim(request("Action")) ID=Trim(Request("ID")) LinkType=trim(request("LinkType")) strFileName="Admin_FriendSite.asp?LinkType=" & LinkType if request("page")<>"" then currentPage=cint(request("page")) else currentPage=1 end if if ID<>"" then if Action="Check" then conn.execute "Update FriendSite set IsOK=True where ID=" & CLng(ID) elseif Action="CancelCheck" then conn.execute "Update FriendSite set IsOK=False Where ID=" & CLng(ID) elseif Action="Good" then conn.execute "Update FriendSite set IsGood=True Where ID=" & CLng(ID) elseif Action="CancelGood" then conn.execute "Update FriendSite set IsGood=False Where ID=" & CLng(ID) elseif Action="Del" then conn.execute "Delete From FriendSite Where ID=" & CLng(ID) end if end if %> 友情链接管理
友 情 链 接 管 理
管理导航： 添加友情链接 | 文字链接 | LOGO链接 | 所有链接

<% if Action="Add" then call Add() elseif Action="SaveAdd" then call SaveAdd() elseif Action="Modify" then call Modify() elseif Action="SaveModify" then call SaveModify() else call main() end if if FoundErr=True then call WriteErrMsg() end if call CloseConn() sub main() sql="select * from FriendSite " if LinkType<>"" then LinkType=CInt(LinkType) if LinkType=1 then sql=sql & " where LinkType=1 " elseif LinkType=2 then sql=sql & " where LinkType=2 " end if end if sql=sql & "order by id desc" set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,1 if rs.eof and rs.bof then response.write "目前共有 0 个友情链接" else totalPut=rs.recordcount if currentpage<1 then currentpage=1 end if if (currentpage-1)*MaxPerPage>totalput then if (totalPut mod MaxPerPage)=0 then currentpage= totalPut \ MaxPerPage else currentpage= totalPut \ MaxPerPage + 1 end if end if if currentPage=1 then showContent showpage strFileName,totalput,MaxPerPage,true,true,"个站点" else if (currentPage-1)*MaxPerPage <% do while not rs.eof %> <% i=i+1 if i>=MaxPerPage then exit do rs.movenext loop %>
链接类型 网站名称 网站LOGO 网站简介 站长 状态 操作
<% if rs("LinkType")=1 then response.write "LOGO链接" else response.write "文字链接" end if %> " target='blank' title="<%=rs("SiteUrl")%>"><%=rs("SiteName")%> <% if rs("LogoUrl")<>"" and rs("LogoUrl")<>"http://" then if lcase(right(rs("LogoUrl"),3))="swf" then Response.Write "" else response.write "" end if else response.write " " end if %> <%=rs("SiteIntro")%> "><%=rs("SiteAdmin")%> <% if rs("IsOK")=True then response.write "已审核" else response.write " " end if if rs("IsGood")=True then response.write "
推荐" end if %> 		<% If rs("IsOK")=False Then response.write "审核通过  " Else response.write "取消审核  " End If response.write "修改
" if rs("IsGood")=False then response.write "设为推荐  " Else response.write "取消推荐  " End If response.write "删除" %>
<% end sub sub Add() %>
添加友情链接
链接类型： Logo链接     文字链接
网站名称： *
网站地址： *
网站Logo：
站长姓名： *
电子邮件： *
网站密码：
用于修改信息时用。		 *
确认密码： *
网站简介：
推荐站点： 是     否
审核通过： 是     否
 
<% end sub sub Modify() if ID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定友情站点ID
    • " exit sub else ID=Clng(ID) end if dim sqlLink,rsLink sqlLink="select * from 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 & "
  • 找不到站点！
    • " rsLink.close set rsLink=nothing exit sub end if %>
    修改友情链接信息
    链接类型： > Logo链接     > 文字链接
    网站名称： " size="30" maxlength="20"> *
    网站地址： " title="这里请输入您的网站地址，最多为50个字符，前面必须带http://"> *
    网站Logo： " title="这里请输入您的网站LogoUrl地址，最多为50个字符，如果您在第一选项选择的是文字链接，这项就不必填">
    站长姓名： " size="30" maxlength="20"> *
    电子邮件： " title="这里请输入您的联系电子邮件，最多为30个字符"> *
    网站密码：
    若不修改，请保持为空
    确认密码：
    网站简介：
    推荐站点： > 是     > 否
    审核通过： > 是     > 否
    ">
    <% rsLink.close set rsLink=nothing end sub %> <% sub SaveAdd() dim LinkType,LinkSiteName,LinkSiteUrl,LinkLogoUrl,LinkSiteAdmin,LinkEmail,LinkSitePassword,LinkSitePwdConfirm,LinkSiteIntro,LinkIsGood,LinkIsOK LinkType=trim(request("LinkType")) LinkSiteName=trim(request("SiteName")) LinkSiteUrl=trim(request("SiteUrl")) LinkLogoUrl=trim(request("LogoUrl")) LinkSiteAdmin=trim(request("SiteAdmin")) LinkEmail=trim(request("Email")) LinkSitePassword=trim(request("SitePassword")) LinkSitePwdConfirm=trim(request("SitePwdConfirm")) LInkSiteIntro=trim(request("SiteIntro")) LinkIsGood=trim(request("IsGood")) LinkIsOK=trim(request("IsOK")) if LinkType="" then FoundErr=True ErrMsg=ErrMsg & "
  • 链接类型不能为空！
    • " else LinkType=Cint(LinkType) if LinkType=1 and (LinkLogoUrl="" or LinkLogoUrl="http://") then FoundErr=True ErrMsg=ErrMsg & "
  • 网站LOGO不能为空！
    • " end if end if if LinkSiteName="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站名称不能为空！
    • " end if if LinkSiteUrl="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站地址不能为空！
    • " end if if LinkSiteAdmin="" then FoundErr=True ErrMsg=ErrMsg & "
  • 站长姓名不能为空！
    • " end if if LinkEmail="" then FoundErr=True ErrMsg=ErrMsg & "
  • Email不能为空！
    • " else if IsValidEmail(LinkEmail)=false then errmsg=errmsg & "
  • Email地址错误!
    • " founderr=true end if end if if LinkSitePassword="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站密码不能为空！
    • " end if if LinkSitePwdConfirm="" 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 LinkSiteIntro="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站简介不能为空！
    • " end if if LinkIsGood="True" then LinkIsGood=True else LinkIsGood=False end if if LinkIsOK="True" then LinkIsOK=True else LinkIsOK=False end if if FoundErr<>True then dim sqlLink,rsLink sqlLink="select top 1 * from FriendSite where SiteName='" & dvHtmlEncode(LinkSiteName) & "' and SiteUrl='" & dvHtmlEncode(LinkSiteUrl) & "'" set rsLink=Server.CreateObject("Adodb.RecordSet") rsLink.open sqlLink,conn,1,3 if not (rsLink.bof and rsLink.eof) then FoundErr=True ErrMsg=ErrMsg & "
  • 你要添加的网站已经存在！
    • " else rsLink.Addnew rsLink("LinkType")=LinkType rsLink("SiteName")=dvHtmlEncode(LinkSiteName) rsLink("SiteUrl")=dvHtmlEncode(LinkSiteUrl) rsLink("LogoUrl")=dvHtmlEncode(LinkLogoUrl) rsLink("SiteAdmin")=dvHtmlEncode(LinkSiteAdmin) rsLink("Email")=dvHtmlEncode(LinkEmail) rsLink("SitePassword")=md5(LinkSitePassword) rsLink("SiteIntro")=dvHtmlEncode(LinkSiteIntro) rsLink("IsGood")=LinkIsGood rsLink("IsOK")=LinkIsOK rsLink.update rsLink.close set rsLink=nothing call CloseConn() Response.Redirect "Admin_FriendSite.asp" end if rsLink.close set rsLink=nothing end if end sub sub SaveModify() if ID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定友情站点ID
    • " exit sub else ID=Clng(ID) end if dim LinkType,LinkSiteName,LinkSiteUrl,LinkLogoUrl,LinkSiteAdmin,LinkEmail,LinkSitePassword,LinkSitePwdConfirm,LinkSiteIntro,LinkIsGood,LinkIsOK LinkType=trim(request("LinkType")) LinkSiteName=trim(request("SiteName")) LinkSiteUrl=trim(request("SiteUrl")) LinkLogoUrl=trim(request("LogoUrl")) LinkSiteAdmin=trim(request("SiteAdmin")) LinkEmail=trim(request("Email")) LinkSitePassword=trim(request("SitePassword")) LinkSitePwdConfirm=trim(request("SitePwdConfirm")) LInkSiteIntro=trim(request("SiteIntro")) LinkIsGood=trim(request("IsGood")) LinkIsOK=trim(request("IsOK")) if LinkType="" then FoundErr=True ErrMsg=ErrMsg & "
  • 链接类型不能为空！
    • " else LinkType=Cint(LinkType) if LinkType=1 and (LinkLogoUrl="" or LinkLogoUrl="http://") then FoundErr=True ErrMsg=ErrMsg & "
  • 网站LOGO不能为空！
    • " end if end if if LinkSiteName="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站名称不能为空！
    • " end if if LinkSiteUrl="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站地址不能为空！
    • " end if if LinkSiteAdmin="" then FoundErr=True ErrMsg=ErrMsg & "
  • 站长姓名不能为空！
    • " end if if LinkEmail="" then FoundErr=True ErrMsg=ErrMsg & "
  • Email不能为空！
    • " else if IsValidEmail(LinkEmail)=false then errmsg=errmsg & "
  • Email地址错误!
    • " founderr=true end if end if if LinkSitePwdConfirm<>LinkSitePassword then FoundErr=True ErrMsg=ErrMsg & "
  • 网站密码与确认密码不一致！
    • " end if if LinkSiteIntro="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站简介不能为空！
    • " end if if LinkSiteIntro="" then FoundErr=True ErrMsg=ErrMsg & "
  • 网站简介不能为空！
    • " end if if LinkIsGood="True" then LinkIsGood=True else LinkIsGood=False end if if LinkIsOK="True" then LinkIsOK=True else LinkIsOK=False end if if FoundErr=True then exit sub end if dim sqlLink,rsLink sqlLink="select * from 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 rsLink("LinkType")=LinkType rsLink("SiteName")=dvHtmlEncode(LinkSiteName) rsLink("SiteUrl")=dvHtmlEncode(LinkSiteUrl) rsLink("LogoUrl")=dvHtmlEncode(LinkLogoUrl) rsLink("SiteAdmin")=dvHtmlEncode(LinkSiteAdmin) rsLink("Email")=dvHtmlEncode(LinkEmail) if LinkSitePassword<>"" then rsLink("SitePassword")=md5(LinkSitePassword) end if rsLink("SiteIntro")=dvHtmlEncode(LinkSiteIntro) rsLink("IsGood")=LinkIsGood rsLink("IsOK")=LinkIsOK rsLink.update rsLink.close set rsLink=nothing call CloseConn() Response.Redirect "Admin_FriendSite.asp" end if rsLink.close set rsLink=nothing end sub %>