<!-- #include file=../../inc/BBSsetup.asp -->
<!-- #include file=../../inc/Board_popfun.asp -->
<!-- #include file=../inc/bbsmanage_Fun.asp -->
<%
DEF_BBS_HomeUrl = "../../"
Const MaxLinkNum = 200
Dim GBL_ID
initDatabase
GBL_CHK_TempStr = ""
GBL_ID = checkSupervisorPass

Dim ReqN,WriteN

SiteHead(DEF_SiteNameString & " - 管理员")
UserTopicTopInfo
DisplayUserNavigate("修改友情链接")
If GBL_CHK_Flag=1 Then
	SiteLink
Else%>
	<table width=96%>
	<tr>
	<td>
	<%
	If Request("submitflag")="" Then
		Response.Write "<br><b>请先登录</b>"
	Else
		Response.Write "<br><p align=left><font color=ff0000 class=RedFont><b>" & GBL_CHK_TempStr & "</b></font>"
	End If
	DisplayLoginForm
	Response.Write "</p>"%>
	</td>
	</tr>
	</table>
<%End If
UserTopicBottomInfo
closeDataBase
SiteBottom
If GBL_ShowBottomSure = 1 Then Response.Write GBL_SiteBottomString

Function SiteLink

ReqN = 0
WriteN = 0
%>
<form name="pollform3sdx" method="post" action="SiteLink.asp" onsubmit="return checksubmit();">
<input type="hidden" name="SubmitFlag" value=yes>
<p>
	<b>
		修改友情链接</b><font color=8888888 class=GrayFont>(下面是友情网站信息，除去网站名表示删除，要增加请点下面的增加按钮)</font>
</p>
<%If Request.Form("SubmitFlag") <> "" Then
	'CheckLinkValue
End If%>
<b><font color=ff0000 class=RedFont><%=GBL_CHK_TempStr%></font></b>
<p>
<div name=SiteString id=SiteString>
<%
If Request.Form("SubmitFlag") <> "" Then
	If GBL_CHK_TempStr <> "" Then
		If Request("SiteName1") = "" Then
			WriteN = 1%>
			<p>网站1<br>
			网站名称：<input type="text" name="SiteName1" maxlength="100" size="50" class=fminpt>(允许HTML)<br>
			网站地址：<input type="text" name="SiteUrl1" maxlength="255" size="50" class=fminpt><br>
			LOGO地址：<input type="text" name="LogoUrl1" maxlength="255" size="50" class=fminpt><br>
			LOGO宽度：<input type="text" name="LogoWidth1" maxlength="5" size="5" value=88 class=fminpt><br>
			LOGO高度：<input type="text" name="LogoHeight1" maxlength="5" size="5" value=31 class=fminpt><br>
			是否换行：<input type="text" name="BreakFlag1" maxlength="5" size="5" class=fminpt>另起一行排版，1-换行，0-自动<br>
			排列顺序：<input type="text" name="OrderID1" maxlength="5" size="5" class=fminpt>越小越前面<br>
		<%Else
			For ReqN = 1 to MaxLinkNum
				If Request("SiteName" & ReqN) <> "" Then
					WriteN = WriteN + 1
			%>
			<p>网站<%=ReqN%><br>
			<input type="hidden" name="SiteID<%=ReqN%>" maxlength="100" size="50" Value="<%=htmlencode(Request("SiteID" & ReqN))%>">
			网站名称：<input type="text" name="SiteName<%=ReqN%>" maxlength="100" size="50" Value="<%=htmlencode(Request("SiteName" & ReqN))%>" class=fminpt>(允许HTML)<br>
			网站地址：<input type="text" name="SiteUrl<%=ReqN%>" maxlength="255" size="50" Value="<%=htmlencode(Request("SiteUrl" & ReqN))%>" class=fminpt><br>
			LOGO地址：<input type="text" name="LogoUrl<%=ReqN%>" maxlength="255" size="50" Value="<%=htmlencode(Request("LogoUrl" & ReqN))%>" class=fminpt><br>
			LOGO宽度：<input type="text" name="LogoWidth<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(Request("LogoWidth" & ReqN))%>" class=fminpt><br>
			LOGO高度：<input type="text" name="LogoHeight<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(Request("LogoHeight" & ReqN))%>" class=fminpt><br>
			是否换行：<input type="text" name="BreakFlag<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(Request("BreakFlag" & ReqN))%>" class=fminpt>另起一行排版，1-换行，0-自动<br>
			排列顺序：<input type="text" name="OrderID<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(Request("SiteUrl" & ReqN))%>" class=fminpt>越小越前面<br>
			<%
				End If
			Next
		End if
	Else
		If SaveSiteLink = 1 Then
			Response.Write "成功更新数据库！"
			MakeDataBaseLinkFile
			Exit Function
		Else
			DisplayDatabaseLink
		End If
	End If
Else
	DisplayDatabaseLink
End If
%>

</div>
<input type=submit name=提交 value=提交 class=fmbtn>
<input type=button name=add value=增加友情链接 onclick="additem();" class=fmbtn>
</form>
注意，如果你的服务器不支持文件写入，将不能自动产生首页友情链接，<br>请手动更改inc\IncHtm\BoardLink.asp的文件内容
<script language=javascript>
var maxNumber=<%=MaxLinkNum%>;
var Number=<%=WriteN%>;
function checksubmit()
{
	return true
}

function additem()
{
	Number+=1;
	if(Number>maxNumber)
	{
		alert("已经达到最大友情链接项目，不能再增加!");
	}
	else
	{
		this.SiteString.innerHTML+="<p>网站"+Number+"<br>";
		this.SiteString.innerHTML+="网站名称：<input type=text name=SiteName"+Number+" maxlength=100 size=50 class=fminpt><br>";
		this.SiteString.innerHTML+="网站地址：<input type=text name=SiteUrl"+Number+" maxlength=255 size=50 class=fminpt><br>";
		this.SiteString.innerHTML+="LOGO地址：<input type=text name=LogoUrl"+Number+" maxlength=255 size=50 class=fminpt><br>";
		this.SiteString.innerHTML+="LOGO宽度：<input type=text name=LogoWidth"+Number+" maxlength=5 size=5 value=88 class=fminpt><br>";
		this.SiteString.innerHTML+="LOGO高度：<input type=text name=LogoHeight"+Number+" maxlength=5 size=5 value=31 class=fminpt><br>";
		this.SiteString.innerHTML+="是否换行：<input type=text name=BreakFlag"+Number+" maxlength=5 size=5 value=0 class=fminpt><br>";
		this.SiteString.innerHTML+="排列顺序：<input type=text name=OrderID"+Number+" maxlength=5 size=5 class=fminpt><br>";
		this.scroll(0, 65000);
	}
}
</script>
<%

End Function

Function DisplayDatabaseLink

	Dim Rs,SQL,GetData
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	SQL = "select ID,SiteName,SiteUrl,LogoUrl,OrderID,LogoWidth,LogoHeight,BreakFlag from LeadBBS_Link order by OrderID,ID ASC"
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		WriteN = 1
		%>
		<p>网站1<br>
		网站名称：<input type="text" name="SiteName1" maxlength="100" size="50" class=fminpt>(允许HTML)<br>
		网站地址：<input type="text" name="SiteUrl1" maxlength="255" size="50" class=fminpt><br>
		LOGO地址：<input type="text" name="LogoUrl1" maxlength="255" size="50" class=fminpt><br>
		LOGO宽度：<input type="text" name="LogoWidth1" maxlength="5" size="5" value=88 class=fminpt><br>
		LOGO高度：<input type="text" name="LogoHeight1" maxlength="5" size="5" value=31 class=fminpt><br>
		是否换行：<input type="text" name="BreakFlag1" maxlength="5" size="5" class=fminpt>另起一行排版，1-换行，0-自动<br>
		排列顺序：<input type="text" name="OrderID1" maxlength="5" size="5" class=fminpt>越小越前面<br>
		<%
		Exit function
	Else
		GetData = Rs.GetRows(-1)
		Rs.Close
		Set Rs = Nothing
	End If

	WriteN = Ubound(GetData,2)+1
	For SQL = 0 To Ubound(GetData,2)
		ReqN = SQL + 1
		If GetData(7,SQL) = True or GetData(7,SQL) = 1 Then
			GetData(7,SQL) = 1
		Else
			GetData(7,SQL) = 0
		End If
		%>
		<p>网站<%=ReqN%><br>
		<input type="hidden" name="SiteID<%=ReqN%>" Value="<%=GetData(0,SQL)%>">
		网站名称：<input type="text" name="SiteName<%=ReqN%>" maxlength="100" size="50" Value="<%=htmlencode(GetData(1,SQL))%>" class=fminpt>(允许HTML)<br>
		网站地址：<input type="text" name="SiteUrl<%=ReqN%>" maxlength="255" size="50" Value="<%=htmlencode(GetData(2,SQL))%>" class=fminpt><br>
		LOGO地址：<input type="text" name="LogoUrl<%=ReqN%>" maxlength="255" size="50" Value="<%=htmlencode(GetData(3,SQL))%>" class=fminpt><br>
		LOGO宽度：<input type="text" name="LogoWidth<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(GetData(5,SQL))%>" class=fminpt><br>
		LOGO高度：<input type="text" name="LogoHeight<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(GetData(6,SQL))%>" class=fminpt><br>
		是否换行：<input type="text" name="BreakFlag<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(GetData(7,SQL))%>" class=fminpt>另起一行排版，1-换行，0-自动<br>
		排列顺序：<input type="text" name="OrderID<%=ReqN%>" maxlength="5" size="5" Value="<%=htmlencode(GetData(4,SQL))%>" class=fminpt>越小越前面<br>
		<%
	Next

End Function

Function CheckLinkValue

	Dim N
	Dim SiteName,SiteUrl,LogoUrl,LogoWidth,LogoHeight,BreakFlag,OrderID
	For N = 0 to MaxLinkNum
		SiteName = Trim(Request("SiteName" & N+1))
		SiteUrl = Trim(Request("SiteUrl" & N+1))
		LogoUrl = Trim(Request("LogoUrl" & N+1))
		LogoWidth = Left(Trim(Request("LogoWidth" & N+1)),14)
		LogoHeight = Left(Trim(Request("LogoHeight" & N+1)),14)
		BreakFlag = Trim(Request("BreakFlag" & N+1))
		OrderID = Trim(Request("OrderID" & N+1))
		If SiteName <> "" Then
			'If SiteUrl = "" Then
			'	GBL_CHK_TempStr = "错误，网站" & N + 1 & "的网址未填写．<br>" & VbCrLf
			'	Exit function
			'End If
			
			If LogoUrl <> "" Then
				If isNumeric(LogoWidth) = 0 Then LogoWidth = 0
				LogoWidth = fix(cCur(LogoWidth))
				If isNumeric(LogoHeight) = 0 Then LogoHeight = 0
				LogoHeight = fix(cCur(LogoHeight))
				If LogoWidth < 1 Then LogoWidth = 1
				If LogoWidth > 1000 Then LogoWidth = 1000
				If LogoHeight < 1 Then LogoHeight = 1
				If LogoHeight > 1000 Then LogoHeight = 1000
			Else
				LogoWidth = 88
				LogoHeight = 31
			End If
			
			If BreakFlag <> "1" and BreakFlag <> "0" Then BreakFlag = 0
			
			If isNumeric(OrderID) = 0 Then OrderID = 0
			OrderID = fix(cCur(OrderID))
			If OrderID < 0 Then OrderID = 0
		End If
	Next

End Function

Function SaveSiteLink

	Dim N
	Dim SiteID,SiteName,SiteUrl,LogoUrl,LogoWidth,LogoHeight,BreakFlag,OrderID
	GBL_DBNum = GBL_DBNum + 1
	For N = 0 to MaxLinkNum
		SiteID = Trim(Left(Request("SiteID" & N+1),14))
		SiteName = Trim(Request("SiteName" & N+1))
		SiteUrl = Trim(Request("SiteUrl" & N+1))
		LogoUrl = Trim(Request("LogoUrl" & N+1))
		LogoWidth = Left(Trim(Request("LogoWidth" & N+1)),14)
		LogoHeight = Left(Trim(Request("LogoHeight" & N+1)),14)
		BreakFlag = Trim(Request("BreakFlag" & N+1))

		If inStr(LCase(SiteName),"<%") or inStr(LCase(SiteName),"include") or (inStr(LCase(SiteName),"server") and inStr(LCase(SiteName),"script")) Then
			Response.Write "<p><br><font color=red class=RedFont>第" & N + 1 & "网站名称中含有<%，include，Server等字符，请仔细检查！</font></p>" & VbCrLf
			SaveSiteLink = 0
			Exit Function
		End If
		If inStr(LCase(SiteUrl),"<%") or inStr(LCase(SiteName),"SiteUrl") or (inStr(LCase(SiteUrl),"server") and inStr(LCase(SiteUrl),"script")) Then
			Response.Write "<p><br><font color=red class=RedFont>第" & N + 1 & "网站地址中含有<%，include，Server等字符，请仔细检查！</font></p>" & VbCrLf
			SaveSiteLink = 0
			Exit Function
		End If
		If inStr(LCase(LogoUrl),"<%") or inStr(LCase(LogoUrl),"SiteUrl") or (inStr(LCase(LogoUrl),"server") and inStr(LCase(LogoUrl),"script")) Then
			Response.Write "<p><br><font color=red class=RedFont>第" & N + 1 & "Logo地址中含有<%，include，Server等字符，请仔细检查！</font></p>" & VbCrLf
			SaveSiteLink = 0
			Exit Function
		End If

		OrderID = Left(Trim(Request("OrderID" & N+1)),14)
			'If SiteUrl = "" Then
			'	GBL_CHK_TempStr = "错误，网站" & N + 1 & "的网址未填写．<br>" & VbCrLf
			'	Exit function
			'	SaveSiteLink = 0
			'End If
			
			If LogoUrl <> "" Then
				If isNumeric(LogoWidth) = 0 Then LogoWidth = 0
				LogoWidth = fix(cCur(LogoWidth))
				If isNumeric(LogoHeight) = 0 Then LogoHeight = 0
				LogoHeight = fix(cCur(LogoHeight))
				If LogoWidth < 1 Then LogoWidth = 1
				If LogoWidth > 1000 Then LogoWidth = 1000
				If LogoHeight < 1 Then LogoHeight = 1
				If LogoHeight > 1000 Then LogoHeight = 1000
			Else
				LogoWidth = 88
				LogoHeight = 31
			End If
			
			If BreakFlag <> "1" and BreakFlag <> "0" Then BreakFlag = 0
			
			If isNumeric(OrderID) = 0 Then OrderID = 0
			OrderID = fix(cCur(OrderID))
			If OrderID < 0 Then OrderID = 0
			
			If isNumeric(SiteID) = 0 Then SiteID = 0
			SiteID = fix(cCur(SiteID))
			If SiteID < 0 Then SiteID = 0
			If SiteID = 0 and SiteName <> "" Then
				Con.ExeCute("insert into LeadBBS_Link(SiteName,SiteUrl,LogoUrl,LogoWidth,LogoHeight,BreakFlag,OrderID)" & _
					" Values('" & Replace(SiteName,"'","''") & "','" & Replace(SiteUrl,"'","''") & "','" & Replace(LogoUrl,"'","''") & "'," & LogoWidth & "," & LogoHeight & "," & BreakFlag & "," & OrderID & ")")
				GBL_DBNum = GBL_DBNum + 1
			ElseIf SiteName = "" and SiteID > 0 Then
				Con.ExeCute("Delete from LeadBBS_Link where ID=" & SiteID)
				GBL_DBNum = GBL_DBNum + 1
			ElseIf SiteID > 0 Then
				Con.ExeCute("Update LeadBBS_Link Set SiteName='" & Replace(SiteName,"'","''") & "',SiteUrl='" & Replace(SiteUrl,"'","''") & "',LogoUrl='" & Replace(LogoUrl,"'","''") & "',LogoWidth=" & LogoWidth & ",LogoHeight=" & LogoHeight & ",BreakFlag=" & BreakFlag & ",OrderID=" & OrderID & " Where ID=" & SiteID)
				GBL_DBNum = GBL_DBNum + 1
			End If
	Next
	SaveSiteLink = 1

End Function


Function MakeDataBaseLinkFile

	Dim TempStr
	TempStr = ""
	Dim Rs,SQL,GetData
	Dim SiteName,SiteUrl,LogoUrl,OrderID,LogoWidth,LogoHeight,BreakFlag
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	SQL = "select ID,SiteName,SiteUrl,LogoUrl,OrderID,LogoWidth,LogoHeight,BreakFlag from LeadBBS_Link order by OrderID"
	Rs.Open SQL,con,1,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		TempStr = TempStr & " "
		Rs.Close
		Set Rs = Nothing
	Else
		GetData = Rs.GetRows(-1)
		Rs.Close
		Set Rs = Nothing
		TempStr = TempStr & "<" & chr(37) & " If GBL_TableHeadString <> """" Then " & chr(37) & "><table width=100% border=0 cellspacing=0 cellpadding=0 align=center><tr><td><" & chr(37) & "=GBL_TableHeadString" & chr(37) & "></td></tr></table><" & chr(37) & " End If " & chr(37) & ">" & VbCrLf
		TempStr = TempStr & "<table width=100" & chr(37) & " border=0 cellspacing=1 cellpadding=5 align=center bgcolor=" & chr(60) & "%=DEF_BBS_DarkColor" & chr(37) & "> class=TBone>" & VbCrLf
		'TempStr = TempStr & "<tr bgcolor=<" & chr(37) & "=DEF_BBS_LightDarkColor" & chr(37) & ">>" & VbCrLf
		'TempStr = TempStr & "	<td class=TBHead><img src=images/NULL.GIF width=2 height=3><br><b><font color=ffffff class=HeadFont>友情链接</font><b></td></tr>" & VbCrLf
		'TempStr = TempStr & "<table width=100% border=0 cellspacing=1 cellpadding=7 align=center bgcolor=" & chr(60) & "%=DEF_BBS_DarkColor" & chr(37) & "> class=TBone>" & VbCrLf
		TempStr = TempStr & "<tr bgcolor=<" & chr(37) & "=DEF_BBS_LightestColor" & chr(37) & "> class=TBBG9>" & VbCrLf
		TempStr = TempStr & "	<td>" & VbCrLf
		For SQL = 0 To Ubound(GetData,2)
			If GetData(7,SQL) = True or GetData(7,SQL) = 1 Then
				GetData(7,SQL) = 1
			Else
				GetData(7,SQL) = 0
			End If
			TempStr = TempStr & "" & VbCrLf
			If GetData(2,SQL) <> "" Then TempStr = TempStr & "<a href=""" & htmlencode(GetData(2,SQL)) & """ target=_blank>" & VbCrLf
			If GetData(3,SQL) <> "" Then
				TempStr = TempStr & "<img src=""" & htmlencode(GetData(3,SQL)) & """ width=" & GetData(5,SQL) & " height=" & GetData(6,SQL) & " border=0 title=""" & htmlencode(GetData(1,SQL)) & """ align=absmiddle>"
			Else
				TempStr = TempStr & GetData(1,SQL)
			End If
			If GetData(2,SQL) <> "" Then TempStr = TempStr & "</a>"
			If GetData(7,SQL) = 1 Then
				TempStr = TempStr & "<br><img src=images/NULL.GIF height=4 width=2><br>" & VbCrLf
			End If
		Next
		TempStr = TempStr & "&nbsp;</td>" & VbCrLf
		TempStr = TempStr & "</tr>" & VbCrLf
		TempStr = TempStr & "</table>" & VbCrLf
		TempStr = TempStr & "<" & chr(37) & " If GBL_TableBottomString <> """" Then " & chr(37) & "><table width=100% border=0 cellspacing=0 cellpadding=0 align=center><tr><td><" & chr(37) & "=GBL_TableBottomString" & chr(37) & "></td></tr></table><" & chr(37) & " End If " & chr(37) & ">"
	End If

	ADODB_SaveToFile TempStr,"../../inc/IncHtm/BoardLink.asp"
	If GBL_CHK_TempStr = "" Then
		Response.Write "<br><font color=Green class=GreenFont>2.成功完成设置！</font>"
	Else
		%><%=GBL_CHK_TempStr%><br>服务器不支持在线写入文件功能，请使用FTP等功能，将<font color=Red Class=RedFont>inc/IncHtm/BoardLink.asp</font>文件替换成框中内容(注意备份)<p>
		<textarea name="fileContent" cols="80" rows="30" class=fmtxtra><%=Server.htmlencode(TempStr)%></textarea><%
		GBL_CHK_TempStr = ""
	End If

End Function
%>