forumboard_fun.asp

一个完整的BBS论坛源代码

			GBL_CHK_TempStr = GBL_CHK_TempStr & "Error: 此版面拥有子（下级）论坛，不能删除!<br>" & VbCrLf
			Rs.Close
			Set Rs = Nothing
			Exit Function
		End if
		ParentBoard = cCur(Rs(0))
		MasterList = Rs(2)
		Rs.Close
		Set Rs = Nothing
		Set Rs = Con.ExeCute("Select top 1 ID from LeadBBS_Announce where BoardID=" & BoardID)
		If Not Rs.Eof Then
			GBL_CHK_TempStr = GBL_CHK_TempStr & "Error: 此版面下还有帖子存在，不能完成删除操作!<br>" & VbCrLf
			DeleteForumBoard = 0
			Rs.Close
			Set Rs = Nothing
			Exit Function
		End If
		Rs.Close
		Set Rs = Nothing
		con.execute("delete from LeadBBS_GoodAssort where BoardID=" & BoardID)
		con.execute("delete from LeadBBS_Boards where BoardID=" & BoardID)
		UpdateMasterList MasterList,0
		DeleteForumBoard = 1
	End if
	ReloadBoardInfo(BoardID)
	If ParentBoard > 0 Then
		UpdateParentBoard_LowerBoardColumn2(ParentBoard)
		ReloadBoardInfo(ParentBoard)
	End If
	ReloadBoardListData

	MakeBoardList "BoardJump.asp","Board.asp"
	MakeBoardList "BoardJump2.asp","Board2.asp"
	MakeBoardList_For_MoveAnnounce

End Function

Rem 插入某版面
Function InsertForumBoard

	If CheckForumAssortIDExist(GBL_BoardAssort) = 0 Then
		InsertForumBoard = 0
		GBL_CHK_TempStr = GBL_CHK_TempStr & "版面所在的分类ID号" & GBL_BoardAssort & "不存在!<br>" & VbCrLf
		Exit Function
	End If

	If CheckForumBoardIDExist(GBL_BoardID) = 1 Then
		InsertForumBoard = 0
		GBL_CHK_TempStr = GBL_CHK_TempStr & "版面ID号" & GBL_BoardID & "已经存在!<br>" & VbCrLf
		Exit Function
	End If

	If CheckForumBoardNameExist(GBL_BoardName) = 1 Then
		InsertForumBoard = 0
		GBL_CHK_TempStr = GBL_CHK_TempStr & "版面名称" & htmlencode(GBL_BoardName) & "已经存在!<br>" & VbCrLf
		Exit Function
	End If

	con.execute("insert into LeadBBS_Boards(BoardID,BoardAssort,BoardName,BoardIntro,LastWriter," &_
			"LastWriteTime,TopicNum,AnnounceNum,ForumPass,HiddenFlag,MasterList,BoardLimit,BoardStyle,StartTime,EndTime,BoardHead,BoardBottom,BoardImgUrl,BoardImgWidth,BoardImgHeight,ParentBoard,LowerBoard,ParentBoardStr,BoardLevel,OtherLimit) values(" &_
			GBL_BoardID & "," & Replace(GBL_BoardAssort,"'","''") & ",'" & Replace(GBL_BoardName,"'","''") & "','" & Replace(GBL_BoardIntro,"'","''") & "','" & Replace(GBL_LastWriter,"'","''") & "'," &_
			GBL_LastWriteTime & "," & GBL_TopicNum & "," & GBL_AnnounceNum & ",'" & Replace(GBL_ForumPass,"'","''") & "'" & _
			"," & GBL_HiddenFlag & ",'" & Replace(GBL_MasterList,"'","''") & "'," & GBL_BoardLimit & "," & GBL_BoardStyle & "," & GBL_StartTime & "," & GBL_EndTime & ",'','','',0,0," & GBL_ParentBoard & ",'" & Replace(GBL_LowerBoard,"'","''") & "'," & GBL_BoardID & ",1," & GBL_OtherLimit & ")")


	If GBL_MasterList <> "?LeadBBS?" Then UpdateMasterList GBL_MasterList,1

	ReloadBoardInfo(GBL_BoardID)
	ReloadBoardListData

	MakeBoardList "BoardJump.asp","Board.asp"
	MakeBoardList "BoardJump2.asp","Board2.asp"
	MakeBoardList_For_MoveAnnounce

	InsertForumBoard = 1

End Function

Rem 得到某版面信息
Function GetForumBoardData(BoardID)

	Dim Rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select * from LeadBBS_Boards Where BoardID = " & BoardID,con,1,1
	If Rs.Eof Then
		GetForumBoardData = 0
		Rs.Close
		Set Rs = Nothing
		Exit Function
	Else
		GBL_GetData = Rs.GetRows(-1)
		Rs.Close
		Set Rs = Nothing
		GetForumBoardData = 1
		Exit Function
	End If

End Function

Rem 更新某版面
Function UpdateForumBoard
	
	If isNumeric(GBL_MODIFYID) = 0 or GBL_MODIFYID = "" Then GBL_MODIFYID = 0
	GBL_MODIFYID = cCur(GBL_MODIFYID)
	If GBL_MODIFYID = 0 or GBL_MODIFYID<1 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "Error: 要修改的版面不存在！<br>" & VbCrLf
		GBL_CHK_Flag = 0
		UpdateForumBoard = 0
		Exit Function
	End If

	If GetForumBoardData(GBL_MODIFYID) = 0 Then
		GBL_CHK_Flag = 0
		UpdateForumBoard = 0
		Exit Function
	End If

	If cCur(GBL_GetData(0,0))<>GBL_BoardID and CheckForumBoardIDExist(GBL_BoardID) = 1 Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "Error: 版面ID号" & GBL_BoardID & "已经存在，请使用其它ID号。<br>" & VbCrLf
		GBL_CHK_Flag = 0
		UpdateForumBoard = 0
		Exit Function
	End If
	
	If GBL_ParentBoard > 0 Then
		If CheckForumBoardIDExist(GBL_ParentBoard) = 0 Then
			GBL_CHK_TempStr = "上级版面编号" & GBL_ParentBoard & "不存在，请正确填写！<br>" & VbCrLf
			GBL_CHK_Flag = 0
			UpdateForumBoard = 0
			Exit Function
		End If
	End If
			
	If CheckBoardRelation(GBL_ParentBoard,GBL_BoardID) = 0 Then
		UpdateForumBoard = 0
		Exit Function
	End if

	If UpdateParentBoard_LowerBoardColumn(GBL_ParentBoard,GBL_BoardID) = 0 Then
		UpdateForumBoard = 0
		Exit Function
	End if
	
	Dim Temp
	Temp = CheckForumBoardNameExist(GBL_BoardName)
	'If Temp<>0 and Temp<>cCur(GBL_GetData(0,0)) Then
	'	GBL_CHK_TempStr = GBL_CHK_TempStr & "Error: 已经存在名称为<b>" & htmlencode(GBL_BoardName) & "</b>的版面<br>" & VbCrLf
	'	GBL_CHK_Flag = 0
	'	UpdateForumBoard = 0
	'	Exit Function
	'End If

	If GBL_MasterList_Old <> "?LeadBBS?" and GBL_MasterList_Old <> GBL_MasterList Then UpdateMasterList GBL_MasterList_Old,0

	con.execute("Update LeadBBS_Boards Set BoardAssort=" & GBL_BoardAssort & ",BoardName='" & Replace(GBL_BoardName,"'","''") & "',BoardIntro='" & Replace(GBL_BoardIntro,"'","''") & "'" &_
	",LastWriter='" & Replace(GBL_LastWriter,"'","''") & "',LastWriteTime=" & GBL_LastWriteTime & ",TopicNum=" & GBL_TopicNum & ",AnnounceNum=" & GBL_AnnounceNum & ",ForumPass='" & Replace(GBL_ForumPass,"'","''") & "',HiddenFlag=" & GBL_HiddenFlag & _
	",MasterList='" & Replace(GBL_MasterList,"'","''") & "'" & _
	",BoardLimit=" & GBL_BoardLimit & _
	",OrderID=" & GBL_OrderID & _
	",BoardStyle=" & GBL_BoardStyle & _
	",StartTime=" & GBL_StartTime & _
	",EndTime=" & GBL_EndTime & _
	",BoardHead='" & Replace(GBL_BoardHead,"'","''") & "'" &_
	",BoardBottom='" & Replace(GBL_BoardBottom,"'","''") & "'" &_
	",BoardImgUrl='" & Replace(GBL_BoardImgUrl,"'","''") & "'" &_
	",BoardImgWidth=" & GBL_BoardImgWidth & _
	",BoardImgHeight=" & GBL_BoardImgHeight & _
	",ParentBoard=" & GBL_ParentBoard & _
	",OtherLimit=" & GBL_OtherLimit & _
	" where BoardID=" & GBL_GetData(0,0))

	If GBL_ParentBoard <> GBL_ParentBoard_Old or GBL_OrderID_Old <> GBL_OrderID Then
		UpdateParentBoard_LowerBoardColumn2(GBL_ParentBoard_Old)
		UpdateParentBoard_LowerBoardColumn2(GBL_ParentBoard)
		UpdateParentBoardStrColumn GBL_ParentBoard_Old,GBL_ParentBoard,cCur(GBL_GetData(0,0))
	End If

	
	If GBL_MasterList <> "?LeadBBS?" and GBL_MasterList_Old <> GBL_MasterList Then UpdateMasterList GBL_MasterList,1

	ReloadBoardInfo(GBL_GetData(0,0))
	ReloadBoardListData

	MakeBoardList "BoardJump.asp","Board.asp"
	MakeBoardList "BoardJump2.asp","Board2.asp"
	MakeBoardList_For_MoveAnnounce

	UpdateForumBoard = 1

End Function

Function UpdateMasterList(MasterList,Flag)

	Rem 重新更新论坛用户版主状态
	Dim TA,N

	TA = Split(MasterList,",")
	For N = 0 to Ubound(TA,1)
		If TA(N) <> "" Then SetUserMastFlag TA(N),Flag
	Next

End Function

Rem 设置某用户是否版主
Function SetUserMastFlag(UserName,Fla)

	Dim Flag
	Flag = Fla
	If Flag <> 1 and Flag <> 0 Then Flag = 0
	Fla = Flag
	Dim Rs,Temp,SQL
	If Flag = 0 Then
		SQL = "Select top 1 BoardID from LeadBBS_Boards where BoardID<>" & GBL_BoardID_Old & " and (MasterList='" & Replace(UserName,"'","''") & "' or MasterList like'" & Replace(UserName,"'","''") & ",%' or MasterList like'%," & Replace(UserName,"'","''") & "' or MasterList like'%," & Replace(UserName,"'","''") & ",%')"
		Set Rs = Con.ExeCute(SQL)
		If Rs.Eof Then
			Flag = 0
		Else
			Flag = 1
		End If
		Rs.Close
		Set Rs = Nothing
	End if

	Dim Tmp
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 UserLimit,ID from LeadBBS_User where UserName='" & Replace(UserName,"'","''") & "'",con,2,2
	If Not Rs.Eof Then
		Temp = Rs(0)
		Tmp = Rs(1)
		If isNull(Temp) Then Temp = 0
		Temp = SetBinarybit(Temp,8,Flag)
		Rs("UserLimit") = Temp
		Rs.Update
		SetUserMastFlag = 1
		Rs.Close
		Set Rs = Nothing
		If Fla = 0 Then
			Con.Execute("Delete from LeadBBS_SpecialUser where Assort=1 and UserID=" & Tmp & " and BoardID=" & GBL_BoardID)
		Else
			Set Rs = Con.ExeCute("Select top 1 ID from LeadBBS_SpecialUser Where Assort=1 and UserID=" & Tmp & " and BoardID=" & GBL_BoardID)
			If Rs.Eof Then
				Rs.Close
				Set Rs = Nothing
				Con.ExeCute("insert into LeadBBS_SpecialUser(UserID,UserName,BoardID,Assort,ndatetime) values(" & Tmp & ",'" & Replace(UserName,"'","''") & "'," & GBL_BoardID & ",1," & GetTimeValue(DEF_Now) & ")")
			Else
				Rs.Close
				Set Rs = Nothing
			End If
		End If
	Else
		SetUserMastFlag = 0
		Rs.Close
		Set Rs = Nothing
	End if

End Function

Rem 判断父级论坛与当前论坛的关系
Function CheckBoardRelation(ParentBoard,BoardID)

	If ParentBoard = 0 Then
		CheckBoardRelation = 1
		Exit Function
	End If

	Dim Rs,BoardAssort
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 BoardAssort from LeadBBS_Boards where BoardID=" & ParentBoard,con,1,1
	If Rs.Eof Then
		CheckBoardRelation = 0
		Rs.close
		Set Rs = Nothing
		GBL_CHK_TempStr = GBL_CHK_TempStr & "父级版面ID号" & ParentBoard & "不存在，请正确填写。<br>" & VbCrLf
		Exit Function
	Else
		BoardAssort = cCur(Rs(0))
	End if
	Rs.Close
	
	If BoardAssort <> GBL_BoardAssort Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "当前版面所在分类必须与父级版面保持一致，请正确填写。<br>" & VbCrLf
		CheckBoardRelation = 0
		Exit Function
	End If

	If GBL_LowerBoard & "" <> "" and GBL_BoardAssort_Old <> GBL_BoardAssort Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "此版面存在下级版面，所以禁止修改所属分类。<br>" & VbCrLf
		CheckBoardRelation = 0
		Exit Function
	End If
	
	Dim ParentBoardTemp
	ParentBoardTemp = ParentBoard
	Dim N
	For N = 1 to 20
		If ParentBoardTemp = 0 then Exit for
		If ParentBoardTemp = GBL_BoardID Then
			GBL_CHK_TempStr = GBL_CHK_TempStr & "父级论坛指定错误，当前版面已经是所填上级论坛的上级或当前版面。<br>" & VbCrLf
			CheckBoardRelation = 0
			Exit Function
		End If
		Rs.Open "Select top 1 ParentBoard from LeadBBS_Boards where BoardID=" & ParentBoardTemp,con,1,1
		If Rs.Eof Then
			Rs.Close
			Exit For
		Else
			ParentBoardTemp = cCur(Rs(0))
			Rs.Close
		End If
	Next
	Set Rs = Nothing
	CheckBoardRelation = 1

End Function

Rem 检测是否还可以修改为父级版面的子版面
Function UpdateParentBoard_LowerBoardColumn(ParentBoard,BoardID)

	If ParentBoard = GBL_ParentBoard_Old Then
		UpdateParentBoard_LowerBoardColumn = 1
		Exit Function
	End If
	Dim Rs,ParentBoardStr
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 LowerBoard,ParentBoardStr from LeadBBS_Boards where BoardID=" & BoardID,con,1,1
	If Rs.Eof Then
		UpdateParentBoard_LowerBoardColumn = 0
		Rs.close
		Set Rs = Nothing
		GBL_CHK_TempStr = GBL_CHK_TempStr & "父级版面ID号" & ParentBoard & "不存在，请正确填写。<br>" & VbCrLf
		Exit Function
	Else
		GBL_LowerBoardTemp = Rs(0)
		ParentBoardStr = Rs(1)
	End if
	Rs.Close
	Set Rs = Nothing
	Rem 这里更改基本的可允许的层数限制
	If Len(ParentBoardStr & "," & BoardID) > 55 Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "论坛可允许层数超出，请更改父级版面，修改失败。<br>" & VbCrLf
		UpdateParentBoard_LowerBoardColumn = 0
		Exit Function
	End If
	
	If inStr("," & GBL_LowerBoardTemp & ",","," & BoardID & ",") Then
	Else
		If Len(GBL_LowerBoardTemp & "," & BoardID) > 255 Then
			GBL_CHK_TempStr = GBL_CHK_TempStr & "选择的父级版已经达到允许的最多子论坛数目，修改失败。<br>" & VbCrLf
			UpdateParentBoard_LowerBoardColumn = 0
			Exit Function
		End If
	End If
	UpdateParentBoard_LowerBoardColumn = 1

End Function

Rem 更新父级版面的子版面数据
Function UpdateParentBoard_LowerBoardColumn2(ParentBoard)

	If ParentBoard < 1 Then Exit Function
	Dim Rs,Temp
	Set Rs = Con.ExeCute("Select BoardID from LeadBBS_Boards where ParentBoard=" & ParentBoard & " and HiddenFlag = 0 order by BoardAssort,OrderID ASC")
	If Rs.Eof Then
		Temp = ""
	Else
		Temp = Rs(0)
		Rs.MoveNext
		Do while Not Rs.Eof
			Temp = Temp & "," & Rs(0)
			Rs.MoveNext
		Loop
	End If
	Rs.Close
	Set Rs = Nothing