📄 forumboard_fun.asp

📁 一个完整的BBS论坛源代码
💻 ASP
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
	Con.ExeCute("Update LeadBBS_Boards Set LowerBoard='" & Replace(Temp,"'","''") & "' Where BoardID=" & ParentBoard)
	ReloadBoardInfo(ParentBoard)

End Function

Rem 更新父级版面数据
Function UpdateParentBoardStrColumn(ParentOld,ParentNew,BoardID)

	If ParentOld = ParentNew Then Exit Function
	Dim Rs,SQL
	Dim ParentBoardStrOld,ParentBoardStrNew,Level
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	If ParentOld = 0 Then
		ParentBoardStrOld = BoardID
	Else
		SQL = "Select top 1 ParentBoardStr from LeadBBS_Boards where BoardID=" & ParentOld
		Rs.Open SQL,con,1,1
		If Rs.Eof Then
			ParentBoardStrOld = BoardID
		Else
			ParentBoardStrOld = Rs(0)
			If isNull(ParentBoardStrOld) or ParentBoardStrOld = "" Then
				ParentBoardStrOld = BoardID
			Else
				ParentBoardStrOld = ParentBoardStrOld & "," & BoardID
			End If
		End If
		Rs.Close
	End If

	If ParentNew = 0 Then
		ParentBoardStrNew = BoardID
	Else
		SQL = "Select top 1 ParentBoardStr from LeadBBS_Boards where BoardID=" & ParentNew
		Rs.Open SQL,con,1,1
		If Rs.Eof Then
			ParentBoardStrNew = BoardID
		Else
			ParentBoardStrNew = Rs(0)
			If isNull(ParentBoardStrNew) or ParentBoardStrNew = "" Then
				ParentBoardStrNew = BoardID
			Else
				ParentBoardStrNew = ParentBoardStrNew & "," & BoardID
			End If
		End If
		Rs.Close
	End If

	Dim Temp,Temp1
	SQL = "Select BoardID,ParentBoardStr from LeadBBS_Boards where ParentBoardStr like'" & Replace(ParentBoardStrOld,"'","''") & ",%'"
	Rs.Open SQL,con,1,1
	Do While Not Rs.Eof
		Temp = cCur(Rs(0))
		Temp1 = Rs(1)
		Temp1 = Replace("a" & Temp1,"a" & ParentBoardStrOld & ",",ParentBoardStrNew & ",")
		Level = Ubound(Split(Temp1,","),1) + 1
		Con.ExeCute("Update LeadBBS_Boards Set ParentBoardStr='" & Replace(Temp1,"'","''") & "',BoardLevel=" & Level & " where BoardID=" & Temp)
		If Temp <> BoardID Then ReloadBoardInfo(Temp)
		Rs.MoveNext
	Loop
	Rs.Close
	Set Rs = Nothing
	Level = Ubound(Split(ParentBoardStrNew,","),1) + 1
	Con.ExeCute("Update LeadBBS_Boards Set ParentBoardStr='" & Replace(ParentBoardStrNew,"'","''") & "',BoardLevel=" & Level & " where BoardID=" & BoardID & " and ParentBoardStr='" & Replace(ParentBoardStrOld,"'","''") & "'")

End Function

Function MakeBoardList(savefile,filename)

	Dim Rs,GetData,BoardNum
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select BoardID,BoardAssort,BoardName,BoardIntro,LastWriter,LastWriteTime,TopicNum,AnnounceNum,ForumPass,HiddenFlag,LastAnnounceID,LastTopicName,MasterList,BoardLimit,LeadBBS_Assort.AssortID,LeadBBS_Assort.AssortName,LowerBoard from LeadBBS_Boards inner join LeadBBS_Assort on LeadBBS_Assort.AssortID=LeadBBS_Boards.BoardAssort where LeadBBS_Boards.ParentBoard=0 and LeadBBS_Boards.HiddenFlag = 0 order by LeadBBS_Boards.BoardAssort,LeadBBS_Boards.OrderID ASC",con,1,1
	If Not Rs.Eof Then
		GetData = Rs.GetRows(-1)
		BoardNum = Ubound(GetData,2)
	Else
		BoardNum = -1
	End If
	Rs.Close
	Set Rs = Nothing
	
	'on error resume next
	Dim TempStr
	TempStr = ""

	TempStr = TempStr & "	" & Chr(60) & "SCRIPT LANGUAGE=""JavaScript"">" & VbCrLf
	TempStr = TempStr & "	function surfto1(list)" & VbCrLf
	TempStr = TempStr & "	{" & VbCrLf
	TempStr = TempStr & "		var myindex1  = document.Fmjmp.selectedIndex;" & VbCrLf
	TempStr = TempStr & "		if (myindex1 != 0)" & VbCrLf
	TempStr = TempStr & "		{" & VbCrLf
	TempStr = TempStr & "			var URL = ""../Board"" + document.Fmjmp.jumpto.options[document.Fmjmp.jumpto.selectedIndex].value;" & VbCrLf
	TempStr = TempStr & "			this.location.href = URL; " & VbCrLf
	TempStr = TempStr & "			target = '_self';" & VbCrLf
	TempStr = TempStr & "		}" & VbCrLf
	TempStr = TempStr & "	}" & VbCrLf
	TempStr = TempStr & "	" & Chr(60) & "/SCRIPT>" & VbCrLf
	TempStr = TempStr & "	<table border=0 cellspacing=0 cellpadding=0><form action="""" method=""post"" name=""Fmjmp""><tr><td>" & VbCrLf
	TempStr = TempStr & "	<select name=""jumpto"" onchange=""surfto1(this)"" class=TBBG9>" & VbCrLf
	TempStr = TempStr & "		<option value=""s.asp"">===切换论坛至……====</option>" & VbCrLf
	TempStr = TempStr & "		<option value=""s.asp"">返回论坛首页</option>" & VbCrLf

	If BoardNum = -1 Then
	Else
		Dim N
		CurrentAssosrt = -1183
		Dim WriteStr
		LastAssosrt = cCur(GetData(1,BoardNum))
		Dim LastFlag
		For N = 0 to BoardNum
			WriteStr = ""
			If CurrentAssosrt<>cCur(GetData(1,N)) Then
				CurrentAssosrt = cCur(GetData(1,N))
				If LastAssosrt = CurrentAssosrt Then
					WriteStr = "└┬"
				Else
					WriteStr = "├┬"
				End If
				TempStr = TempStr & "		<option value=""s.asp?Assort=" & GetData(14,N) & """ class=TBBG1>" & WriteStr & KillHTMLLabel(GetData(15,N) & "") & VbCrLf
			End If
			
			If N >= BoardNum Then
				If LastAssosrt = CurrentAssosrt Then
					If GetData(16,n) & ""  = "" Then
						WriteStr = "　└"
					Else
						WriteStr = "　├"
					End if
				Else
					WriteStr = "│└"
				End If
			Else
				If CurrentAssosrt<>cCur(GetData(1,N+1)) Then
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　└"
					Else
						WriteStr = "│└"
					End If
				Else
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　├"
					Else
						WriteStr = "│├"
					End If
				End If
			End If
			WriteStr = WriteStr & KillHTMLLabel(GetData(2,N))
			If StrLength(WriteStr) > 21 Then
				WriteStr = LeftTrue(WriteStr,18) & "..."
			End If
			TempStr = TempStr & "		<option value=""/" & filename & "?BoardID=" & GetData(0,N) & """>" & WriteStr & "" & VbCrLf
			GBL_LowBoardString = ""
			GBL_LoopN = 0
			GetLowBoardString GetData(16,n),filename
			If GBL_LowBoardString <> "" Then TempStr = TempStr & GBL_LowBoardString
		Next
	End If

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

End Function

Dim GBL_LowBoardString,GBL_LoopN
Dim LastAssosrt,CurrentAssosrt
GBL_LoopN = 0
Function GetLowBoardString(LowBoardStr,filename)

	If LowBoardStr = "" or isNull(LowBoardStr) or GBL_LoopN > 100 Then Exit Function
	GBL_LoopN = GBL_LoopN + 1
	Dim BoardNum,LowArray,N
	LowArray = Split(LowBoardStr,",")
	BoardNum = Ubound(LowArray,1)

	Dim Temp
	Dim WriteStr
	For N = 0 to BoardNum
		Temp = Application(DEF_MasterCookies & "BoardInfo" & LowArray(N))
		If isArray(Temp) = False Then
			ReloadBoardInfo(LowArray(N))
			Temp = Application(DEF_MasterCookies & "BoardInfo" & LowArray(N))
		End If
		If isArray(Temp) = True Then
			If Temp(8,0) = 0 Then
				If N >= BoardNum Then
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　" & String(GBL_LoopN, "│") & "├"
					Else
						WriteStr = "│" & String(GBL_LoopN, "│") & "├"
					End If
				Else
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　├"
					Else
						WriteStr = "│" & String(GBL_LoopN, "│") & "├"
					End If
				End If
				'WriteStr = String(GBL_LoopN, "　") & WriteStr
				WriteStr = WriteStr & KillHTMLLabel(Temp(0,0))
				If StrLength(WriteStr) > 21 Then
					WriteStr = LeftTrue(WriteStr,18) & "..."
				End If
				GBL_LowBoardString = GBL_LowBoardString & "		<option value=""/" & filename & "?BoardID=" & LowArray(N) & """>" & WriteStr & "" & VbCrLf
				GetLowBoardString Temp(27,0),filename
			End If
		End If
	Next
		
	GBL_LoopN = GBL_LoopN - 1
	
End Function


Function GetLowBoardString_Move(LowBoardStr)

	If LowBoardStr = "" or isNull(LowBoardStr) or GBL_LoopN > 100 Then Exit Function
	GBL_LoopN = GBL_LoopN + 1
	Dim BoardNum,LowArray,N
	LowArray = Split(LowBoardStr,",")
	BoardNum = Ubound(LowArray,1)

	Dim Temp
	Dim WriteStr
	For N = 0 to BoardNum
		Temp = Application(DEF_MasterCookies & "BoardInfo" & LowArray(N))
		If isArray(Temp) = False Then
			ReloadBoardInfo(LowArray(N))
			Temp = Application(DEF_MasterCookies & "BoardInfo" & LowArray(N))
		End If
		If isArray(Temp) = True Then
			If Temp(8,0) = 0 Then
				If N >= BoardNum Then
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "│" & String(GBL_LoopN, "│") & "├"
					Else
						WriteStr = "│" & String(GBL_LoopN, "│") & "├"
					End If
				Else
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "│├"
					Else
						WriteStr = "│" & String(GBL_LoopN, "│") & "├"
					End If
				End If
				'WriteStr = String(GBL_LoopN, "　") & WriteStr
				WriteStr = WriteStr & KillHTMLLabel(Temp(0,0))
				If StrLength(WriteStr) > 21 Then
					WriteStr = LeftTrue(WriteStr,18) & "..."
				End If
				GBL_LowBoardString = GBL_LowBoardString & "		<option value=" & LowArray(N) & ">" & WriteStr & "" & VbCrLf
				GetLowBoardString_Move Temp(27,0)
			End If
		End If
	Next
		
	GBL_LoopN = GBL_LoopN - 1
	
End Function

Function MakeBoardList_For_MoveAnnounce

	Dim Rs,GetData,BoardNum
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select BoardID,BoardAssort,BoardName,BoardIntro,LastWriter,LastWriteTime,TopicNum,AnnounceNum,ForumPass,HiddenFlag,LastAnnounceID,LastTopicName,MasterList,BoardLimit,LeadBBS_Assort.AssortID,LeadBBS_Assort.AssortName,LowerBoard from LeadBBS_Boards inner join LeadBBS_Assort on LeadBBS_Assort.AssortID=LeadBBS_Boards.BoardAssort where LeadBBS_Boards.ParentBoard=0 and LeadBBS_Boards.HiddenFlag = 0 order by LeadBBS_Boards.BoardAssort,LeadBBS_Boards.OrderID ASC",con,1,1
	If Not Rs.Eof Then
		GetData = Rs.GetRows(-1)
		BoardNum = Ubound(GetData,2)
	Else
		BoardNum = -1
	End If
	Rs.Close
	Set Rs = Nothing

	'on error resume next
	Dim TempStr
	TempStr = ""

	TempStr = TempStr & "	<select name=""BoardID2"" class=TBBG9>" & VbCrLf
	TempStr = TempStr & "		<option value=0>===选择版面…===</option>" & VbCrLf

	If BoardNum = -1 Then
	Else
		Dim CurrentAssosrt,N
		CurrentAssosrt = -1183
		Dim LastAssosrt,WriteStr
		LastAssosrt = cCur(GetData(1,BoardNum))
		Dim LastFlag
		For N = 0 to BoardNum
			WriteStr = ""
			If CurrentAssosrt<>cCur(GetData(1,N)) Then
				CurrentAssosrt = cCur(GetData(1,N))
				If LastAssosrt = CurrentAssosrt Then
					WriteStr = "└┬"
				Else
					WriteStr = "├┬"
				End If
				TempStr = TempStr & "		<option value=0 class=TBBG1>" & WriteStr & KillHTMLLabel(GetData(15,N)) & "" & VbCrLf
			End If
			If N >= BoardNum Then
				If LastAssosrt = CurrentAssosrt Then
					If GetData(16,n) & ""  = "" Then
						WriteStr = "　└"
					Else
						WriteStr = "　├"
					End if
				Else
					WriteStr = "│└"
				End If
			Else
				If CurrentAssosrt<>cCur(GetData(1,N+1)) Then
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　└"
					Else
						WriteStr = "│└"
					End If
				Else
					If LastAssosrt = CurrentAssosrt Then
						WriteStr = "　├"
					Else
						WriteStr = "│├"
					End If
				End If
			End If
			WriteStr = WriteStr & KillHTMLLabel(GetData(2,N))
			If StrLength(WriteStr) > 21 Then
				WriteStr = LeftTrue(WriteStr,18) & "..."
			End If
			TempStr = TempStr & "		<option value=" & GetData(0,N) & ">" & WriteStr & "" & VbCrLf
			GBL_LowBoardString = ""
			GBL_LoopN = 0
			GetLowBoardString_Move GetData(16,n)
			If GBL_LowBoardString <> "" Then TempStr = TempStr & GBL_LowBoardString
			
		Next
	End If

	TempStr = TempStr & "	</select>" & VbCrLf

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

End Function

Function SetBinarybit(Number,bit,value)

	Dim Temp
	Temp = GetBinarybit(Number,bit)

	If Temp = value Then
		SetBinarybit = Number
	ElseIf Temp = 1 and  value = 0 Then
		SetBinarybit = Number - BinaryData(Bit-1)
	ElseIf Temp = 0 and  value = 1 Then
		SetBinarybit = Number + BinaryData(Bit-1)
	End If

End Function
%>
上一页 1 23
💿 文件大小 1076 K
👤 上传用户 sjb545893912
📂 所属分类压缩解压
🏷️ 相关标签

#BBS #论坛 #源代码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -