<% DEF_PubMessageEnable = 1 GBL_CHK_PWdFlag = 0 Dim GBL_ID Dim GBL_REQ_Assort,GBL_TopicNum,GBL_AnnounceNum,GBL_GoodNum,GBL_TodayAnnounce,GBL_StartBoard Dim GBL_OnlineUserNum,GBL_UserCount,GBL_MaxOnline,GBL_OnlineTime,GBL_MaxolTime,GBL_PageCount,GBL_UploadNum Dim GBL_MaxAnnounce,GBL_MaxAncTime,GBL_YesterdayAnc Dim Blist,BoardNum Blist = Application(DEF_MasterCookies & "BList") Function CheckAssort'区版函数，如果首页不发生与区版的关系，可删除该函数 GBL_REQ_Assort = Left(Request.QueryString("Assort"),14) If isNumeric(GBL_REQ_Assort)=0 Then GBL_REQ_Assort=0 GBL_REQ_Assort = Fix(cCur(GBL_REQ_Assort)) Dim BoardNum,N,TempArray GBL_StartBoard = 0 If GBL_REQ_Assort > 0 and isArray(Blist) = True Then BoardNum = Ubound(Blist,2) For N = 0 to BoardNum If GBL_REQ_Assort = cCur(Blist(1,n)) Then TempArray = Application(DEF_MasterCookies & "BoardInfo" & Blist(0,n)) If isArray(TempArray) = True Then GBL_Board_BoardAssort = cCur(TempArray(1,0)) GBL_Board_AssortName = TempArray(14,0) GBL_StartBoard = N Exit For Else GBL_REQ_Assort = 0 GBL_Board_BoardAssort = 0 GBL_Board_AssortName = "" Exit For End If End If Next If N > BoardNum Then GBL_REQ_Assort = 0 Else GBL_REQ_Assort = 0 GBL_Board_BoardAssort = 0 GBL_Board_AssortName = "" End If If cCur(GBL_ShowBottomSure) = 0 and GBL_REQ_Assort > 0 Then GBL_SiteBottomString = "" End Function Function DisplayBoard'页面模板函数，编写整个页面的枢纽 Dim Temp,Flag Flag = 0 Dim GetData If isArray(Blist) = True Then BoardNum = Ubound(Blist,2) Else ReloadBoardListData Blist = Application(DEF_MasterCookies & "BList") If isArray(Blist) = True Then BoardNum = Ubound(Blist,2) Else BoardNum = -1 End if End If %> border=0 cellspacing=1 cellpadding=3 align=center bgcolor=<%=DEF_BBS_DarkColor%> class=TBone><%DisplayBoardList%> border=0 cellspacing=1 cellpadding=3 align=center bgcolor=<%=DEF_BBS_DarkColor%> class=TBone>

<%DisplayInfoBoxNavigate%>

border=0 cellspacing=1 cellpadding=4 bgcolor=<%=DEF_BBS_DarkColor%> class=TBone align=center>

<%If GBL_CHK_User = "" Then DisplayTopInfo else DisplayAnnounceTopUser End If sousuo xinxi%>

<%shownewpics%> border=0 cellspacing=0 cellpadding=0 align=center> <% End Function Sub Main'全局页面函数 BBS_SiteHead DEF_SiteNameString & " " & DEF_BBS_Name,GBL_board_ID,"" CheckAssort DisplayBoard SiteBottom End Sub Function DisplayBoardList'区与版的首页显示函数 OpenDatabase Dim Rs,GetData,BoardNum Set Rs = Server.CreateObject("ADODB.RecordSet") Rs.Open "Select BoardID,BoardAssort,BoardName,LeadBBS_Assort.AssortName from LeadBBS_Boards left join LeadBBS_Assort on LeadBBS_Assort.AssortID=LeadBBS_Boards.BoardAssort where LeadBBS_Boards.HiddenFlag = 0 order by LeadBBS_Assort.AssortID,LeadBBS_Boards.OrderID ASC",con,1,1 GBL_DBNum = GBL_DBNum + 1 If Not Rs.Eof Then GetData = Rs.GetRows(-1) BoardNum = Ubound(GetData,2) Else BoardNum = -1 End If Rs.Close Set Rs = Nothing 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 If CurrentAssosrt<>cCur(GetData(1,N)) Then CurrentAssosrt = cCur(GetData(1,N)) %> class=TBBG9> ><%=WriteStr & GetData(3,N)%> <%End If%> <%=WriteStr & GetData(2,N)%> <% Next Response.Write "" End If End Function Function sousuo'搜索函数，搜索论坛页面，与官方论坛为主 %>

本站搜索

类别 名称 作者

<% End Function Function DisplayTopInfo'登陆信息的描述 %> height=25 class=TBBG9> height=25 class=TBBG9> height=25 class=TBBG9> height=25 class=TBBG9>

用户登陆

帐号:

密码:

Cookies: 无效 一月 一年 一天 两天 一周

忘密 >注册

<% End Function Function shownewtopics(Bid)'首页多主题调用，注意以下的参数与首页的显示有关 Dim ListNum,SQL,Rs,BoardID,HomeUrl,StrLen StrLen = 16 ListNum = 6 HomeUrl = "" BoardID = Bid SQL = "select TOP " & ListNum & " ID,Title,TitleStyle,BoardID,ndatetime from LeadBBS_Topic Where BoardID=" & BoardID & " Order by ID DESC" Set Rs = Con.ExeCute(SQL) GBL_DBNum = GBL_DBNum + 1 Dim Num Dim GetData If Not rs.Eof Then GetData = Rs.GetRows(-1) Num = Ubound(GetData,2) Else Num = -1 End If Rs.close Set Rs = Nothing If Num = -1 Then Response.Write "document.write(""·此版尚未发表文章"");" Response.Write "document.write(""" For SQL = 0 to Num If GetData(2,SQL) = 1 Then GetData(1,SQL) = KillHTMLLabel(GetData(1,SQL)) If Len(GetData(1,SQL)) > StrLen/2 Then If StrLength(GetData(1,SQL)) > StrLen Then GetData(1,SQL) = LeftTrue(GetData(1,SQL),StrLen - 3) & " " End If End If Response.Write "□ " & Replace(htmlencode(GetData(1,SQL)),"\","\\") & " " If mid(GetData(4,SQL),1,8) = Left(GetTimeValue(DEF_Now),8) Then Response.Write "" Else Response.Write "" Response.Write Mid(GetData(4,SQL),3,2) & "-" & Mid(GetData(4,SQL),5,2) & "-" & Mid(GetData(4,SQL),7,2) & "

" Next Response.Write """);" End Function Function DisplayUserNewest'最先注册会员函数 Dim Rs,SQL SQL = "select TOP 1 ID,UserName,ApplyTime from LeadBBS_User Order by ID DESC" Set Rs = Con.ExeCute(SQL) If Not rs.Eof Then Response.Write "" & Rs(1) & "" Else Response.Write "找不到用户。" & VbCrLf End If Rs.Close Set Rs = Nothing End Function Sub xinxi'网站信息调用函数 Dim SQL,Rs SQL = "select sum(TodayAnnounce_All),sum(GoodNum_All),sum(AnnounceNum_All),sum(TopicNum_All) from LeadBBS_Boards where ParentBoard=0" Set Rs = Con.Execute(SQL) GBL_DBNum = GBL_DBNum + 1 If Not Rs.Eof Then GBL_TodayAnnounce = Rs(0) GBL_GoodNum = Rs(1) GBL_AnnounceNum = Rs(2) GBL_TopicNum = Rs(3) Else GBL_TodayAnnounce = 0 GBL_GoodNum = 0 GBL_AnnounceNum = 0 GBL_TopicNum = 0 End If Rs.Close Set Rs = Nothing Dim Temp%> class=TBBG9>

网站信息

<% Response.Write " □-今日新帖：" & GBL_TodayAnnounce & " 篇

" Response.Write " □-主题总量：" & GBL_TopicNum & " 篇

" Response.Write " □-总发帖量：" & GBL_AnnounceNum & " 篇

" Response.Write " □-回复帖子：" & (GBL_AnnounceNum-GBL_TopicNum) & " 篇

" Response.Write " □-精华帖子：" & GBL_GoodNum & " 帖

" Response.Write " □-可见版面：" & BoardNum+1 & " 个

" Response.Write " □-建站天数：" & datediff("d","2004-12-28",date()) & " 天" %>

□-最新会员：  more... <%DisplayUserNewest%> <% Response.Write "

" End Sub Sub DisplayAnnounceTopUser'社区明星函数，与官方的社区调用区别，它是随机变化 Dim Rs,SQL,OrderStr,MoreFlag,OrderName,Shownum,ShowSex Randomize Shownum = Fix(Rnd*4)+1 Select Case Shownum Case 1 ' OrderName = "幸运" MoreFlag = 5 OrderStr = " Order by CharmPoint DESC " Case 2 ' OrderName = "积分" MoreFlag = 1 OrderStr = " Order by Points DESC " Case 3 ' OrderName = "灌水" MoreFlag = 3 OrderStr = " Order by AnnounceNum2 DESC " Case else OrderName = "经验" MoreFlag = 2 OrderStr = " Order by OnlineTime DESC " End Select ShowSex = Fix(Rnd*2)+1 If ShowSex = 1 Then OrderStr = " Where Sex='女' " & OrderStr If ShowSex = 1 Then OrderName = OrderName & "女" SQL = "select TOP 1 ID,UserName,ApplyTime,FaceUrl,Userphoto,Points,AnnounceNum2,OnlineTime,CharmPoint from LeadBBS_User " & OrderStr Set Rs = Con.ExeCute(SQL) If Not rs.Eof Then If isNull(Rs(3)) Then Rs(3) = "" %>

<%=OrderName%>状元榜

<% If DEF_AllDefineFace = 0 or Trim(Rs(3)) = "" Then%> >.gif align=absmiddle width=70 border=0 alt=看什么看？有本事你来当状元！嘻-----> <%Else%> >" align=absmiddle align=absmiddle width=70 border=0 alt=看什么看？有本事你来当状元！嘻-----> <%End If %>

<% Response.Write " □-姓名：" & Rs(1) & " ..." Response.Write " □-积分：" & Rs(5) Response.Write " □-发帖：" & cCur(Rs(6)) Response.Write " □-经验：" & clng(cCur(Rs(7))/60) Response.Write " □-幸运：" & Rs(8) %>

<% Else Response.Write "找不到用户。" & VbCrLf End If Rs.Close Set Rs = Nothing End Sub Sub shownewpics'最先上传的图片调用，注意以下的参数，缺陷是无法调用主题内容，注意修改上传路径 Dim Rs,SQL,NewNum,pic_ListNum,SQLendString,n,width,heihgt pic_ListNum = 15 width = 80 heihgt = 80 SQL = "select TOP " & pic_ListNum & " ID,UserID,PhotoDir,SPhotoDir,NdateTime,FileType from LeadBBS_Upload where PhotoDir like '%.gif' OR PhotoDir like '%.jpg' Order by ID DESC" Set Rs = Con.ExeCute(SQL) GBL_DBNum = GBL_DBNum + 1 Dim Num Dim GetData If Not rs.Eof Then GetData = Rs.GetRows(-1) Num = Ubound(GetData,2) Else Num = -1 End If Rs.close Set Rs = Nothing %> border=0 cellspacing=1 cellpadding=3 align=center bgcolor=<%=DEF_BBS_DarkColor%> class=TBone><% if Num <> -1 then Response.Write "" End If %>

图片更新

" for n= 0 to pic_ListNum-1 Response.Write " " next Response.Write "

<% End Sub Main %>