申请友情链接

<%@language=vbscript codepage=936 %> <% Option Explicit Response.Buffer = True %> <% Action = Trim(request("Action")) If EnableLinkReg <> True Then FoundErr = True ErrMsg = ErrMsg & "

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

" Else If Action = "Reg" Then Call SaveLinkSite Else Call main End If End If If FoundErr = True Then Call WriteErrMsg End If Call CloseConn Sub main() %> 申请友情链接

卖炭翁翻译网链接信息

说明：凡申请与本站互换友情链接者，必须同时与下面的<绿洲翻译资讯网>一起作捆绑式交换
本站名称：	卖炭翁翻译网
本站地址：	http://www.china-linguist.com/
站长姓名：	卖炭翁
电子邮件：	info@china-linguist.com
本站链接代码：	1。文字代码： <a href="http://www.china-linguist.com/" title="炭翁翻译，一字不苟，篇篇精品" target="_blank">卖炭翁翻译网</a> 2。Logo代码： <a href="http://www.china-linguist.com" target="_blank"> <img src="http://www.china-linguist.com/image/cftlogo8831.gif" alt="卖炭翁翻译网" border="1"></a>
本站链接Logo：	（最好将本图片下载到本地）

绿洲翻译资讯网链接信息

本站名称：	绿洲翻译资讯网
本站地址：	http://www.oasis-translation.com/
站长姓名：	卖炭翁
电子邮件：	info@oasis-translation.com
本站链接代码：	1。文字代码： <a href="http://www.oasis-translation.com/" title="打造一流的翻译资讯网站" target="_blank">绿洲翻译资讯网</a> 2。Logo代码： <a href="http://www.oasis-translation.com" target="_blank"> <img src="http://www.oasis-translation.com/images/oasis-logo.gif" alt="绿洲翻译资讯网" border="1"></a>
本站链接Logo：	（最好将本图片下载到本地）
友情提醒：	1。链接申请提交后，请尽快在贵站的首页上增加上两个网站的相应链接，否则申请将不会被通过。 2。链接申请提交后，请在两个网站之一的留言板上发留言告知，以免造成耽搁。留言信息会显示在首页调用中。

<% End Sub Sub SaveLinkSite() Dim KindID, SpecialID, LinkType, LinkSiteName, LinkSiteUrl, LinkLogoUrl, LinkSiteAdmin, LinkSiteEmail, LinkSitePassword, LinkSitePwdConfirm, LinkSiteIntro 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")) LinkSitePassword = Trim(request("SitePassword")) LinkSitePwdConfirm = Trim(request("SitePwdConfirm")) LinkSiteIntro = Trim(request("SiteIntro")) 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 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 FoundErr = True Then Exit Sub End If If LinkLogoUrl = "" Or LinkLogoUrl = "http://" Then LinkType = 2 Else LinkType = 1 End If Dim sqlLink, rsLink LinkSiteName = ReplaceBadChar(LinkSiteName) LinkSiteUrl = ReplaceUrlBadChar(LinkSiteUrl) sqlLink = "select top 1 * from PE_FriendSite where SiteName='" & LinkSiteName & "' and SiteUrl='" & 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("KindID") = KindID rsLink("SpecialID") = SpecialID rsLink("LinkType") = LinkType rsLink("SiteName") = LinkSiteName rsLink("SiteUrl") = LinkSiteUrl rsLink("LogoUrl") = ReplaceUrlBadChar(LinkLogoUrl) rsLink("SiteAdmin") = PE_HTMLEncode(LinkSiteAdmin) rsLink("SiteEmail") = PE_HTMLEncode(LinkSiteEmail) rsLink("SitePassword") = md5(LinkSitePassword, 16) rsLink("SiteIntro") = PE_HTMLEncode(LinkSiteIntro) rsLink("Hits") = 0 rsLink("UpdateTime") = Now rsLink("Passed") = False rsLink.Update Call WriteSuccessMsg("申请友情链接成功！请等待管理员审核通过。") End If rsLink.Close Set rsLink = Nothing End Sub Function GetLogo(LogoWidth, LogoHeight) Dim strLogo, strLogoUrl If LogoUrl <> "" Then If LCase(Left(LogoUrl, 7)) = "http://" Or Left(LogoUrl, 1) = "/" Then strLogoUrl = LogoUrl Else strLogoUrl = strInstallDir & LogoUrl End If If LCase(Right(strLogoUrl, 3)) = "swf" Then strLogo = "

" Else strLogo = "" strLogo = strLogo & "

0 Then strLogo = strLogo & " width='" & LogoWidth & "'" If LogoHeight > 0 Then strLogo = strLogo & " height='" & LogoHeight & "'" strLogo = strLogo & " border='0'>" strLogo = strLogo & "" End If End If GetLogo = strLogo End Function 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 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 %>