📄 bbsxp_class.asp
字号:
End Function
Function ForumList(GroupID,ParentID,Selected)
sql="Select ForumID,ForumName From ["&TablePrefix&"Forums] where GroupID="&GroupID&" and ParentID="&ParentID&" and SortOrder>0 and IsActive=1 order by SortOrder"
Set Rs1=Execute(sql)
Do While Not Rs1.EOF
if RS1("ForumID")=Selected then
ForumsList=ForumsList&"<option value='"&RS1("ForumID")&"' selected>"&string(ii," ")&"-» "&RS1("ForumName")&"</option>"
else
ForumsList=ForumsList&"<option value='"&RS1("ForumID")&"'>"&string(ii," ")&"-» "&RS1("ForumName")&"</option>"
end if
ii=ii+1
ForumList GroupID,RS1("ForumID"),Selected
ii=ii-1
Rs1.MoveNext
loop
Rs1.Close
Set Rs1 = Nothing
End Function
Function ForumTree(selec)
if selec=0 then
Set Rs1=Execute("Select * from ["&TablePrefix&"Groups] where GroupID="&GroupID&"")
if not Rs1.eof then
ForumTreeList="<span id=TempGroup"&GroupID&"><a onmouseover=Ajax_CallBack(false,'TempGroup"&GroupID&"','loading.asp?menu=ForumTree&GroupID="&GroupID&"') href=Default.asp?GroupID="&Rs1("GroupID")&">"&Rs1("GroupName")&"</a></span> → "&ForumTreeList&""
end if
else
Set Rs1=Execute("Select * From ["&TablePrefix&"Forums] where ForumID="&selec&"")
if not Rs1.eof then
ForumTreeList="<span id=tempForum"&selec&"><a onmouseover=Ajax_CallBack(false,'tempForum"&selec&"','loading.asp?menu=ForumTree&ParentID="&selec&"') href=ShowForum.asp?ForumID="&Rs1("ForumID")&">"&Rs1("ForumName")&"</a></span> → "&ForumTreeList&""
ForumTree Rs1("ParentID")
end if
end if
Rs1.Close
Set Rs1 = Nothing
ForumTree=ForumTreeList
End Function
Function ClubTree()
Set Rs1=Execute("Select * From ["&TablePrefix&"Groups] where SortOrder>0 order by SortOrder")
do while not Rs1.eof
ClubTreeList=ClubTreeList&"<div class=menuitems><a href=Default.asp?GroupID="&Rs1("GroupID")&">"&Rs1("GroupName")&"</a></div>"
Rs1.Movenext
loop
Rs1.Close
Set Rs1 = Nothing
ClubTree="<a onmouseover="&Chr(34)&"showmenu(event,'"&ClubTreeList&"')"&Chr(34)&" href=Default.asp>"&SiteConfig("SiteName")&"</a>"
End Function
''''''''''''''''''''''''''''''''
Sub ConciseMsg(Message)
Response.write(Message)
Response.End
End Sub
''''''''''''''''''''''''
Sub Log(Message)
MessageXML=MessageXML&"<Message>"&Message&"</Message>"&vbCrlf
MessageXML=MessageXML&"<REMOTE_ADDR>"&REMOTE_ADDR&"</REMOTE_ADDR>"&vbCrlf
MessageXML=MessageXML&"<Request_Method>"&Escape(Request.ServerVariables("Request_method"))&"</Request_Method>"&vbCrlf
MessageXML=MessageXML&"<Server_Name>"&Escape(Request.ServerVariables("server_name"))&"</Server_Name>"&vbCrlf
MessageXML=MessageXML&"<Script_Name>"&Escape(Request.ServerVariables("script_name"))&"</Script_Name>"&vbCrlf
MessageXML=MessageXML&"<Query_String>"&Escape(Request.ServerVariables("Query_String"))&"</Query_String>"&vbCrlf
MessageXML=MessageXML&"<Request_Form>"&Escape(Request.Form)&"</Request_Form>"&vbCrlf
MessageXML=MessageXML&"<All_Http>"&Escape(Request.ServerVariables("All_Http"))&"</All_Http>"&vbCrlf
Execute("insert into ["&TablePrefix&"EventLog] (UserName,ErrNumber,MessageXML) values ('"&CookieUserName&"','"&Err.Number&"','"&MessageXML&"')")
End Sub
''''''''''''''''''''''''''''''''
Function AjaxShowPage(TotalPage,PageIndex,url)
AjaxShowPage=""
AjaxShowPage="<span class='PageInation' style='float:right;'><a class=MultiPages>"&PageIndex&"/"&TotalPage&"</a>"
if PageIndex<6 then
PageLong=11-PageIndex
elseif TotalPage-PageIndex<6 then
PageLong=10-(TotalPage-PageIndex)
else
PageLong=5
end if
for i=1 to TotalPage
if i < PageIndex+PageLong and i > PageIndex-PageLong or i=1 or i=TotalPage then
if PageIndex=i then
AjaxShowPage=AjaxShowPage&"<a class=CurrentPage>"& i &"</a>"
else
AjaxShowPage=AjaxShowPage&"<a class=PageNum href=""Javascript:Ajax_CallBack(false,'CommentArea','"&url&"&PageIndex="&i&"')"">"& i &"</a>"
end if
end if
next
AjaxShowPage=AjaxShowPage&"</span>"
End Function
''''''''''''''''''''''''''''''''
Sub UpdateStatistics(DaysUsers,DaysTopics,DaysPosts)
sql="Select * from ["&TablePrefix&"Statistics] where DateDiff("&SqlChar&"d"&SqlChar&",DateCreated,"&SqlNowString&")=0"
Rs.open sql,conn,1,3
if Rs.eof then
Rs.Addnew
TotalUsers=Execute("Select count(UserID) from ["&TablePrefix&"Users]")(0)
TotalTopics=Execute("Select count(ThreadID) from ["&TablePrefix&"Threads] where Visible=1")(0)
TotalPosts=Execute("Select sum(TotalReplies) as TotalPosts from ["&TablePrefix&"Threads] where Visible=1")(0)
if IsNull(TotalPosts) then
TotalPosts=0
else
NewestUserName=Execute("Select Top 1 UserName from ["&TablePrefix&"Users] order by UserID desc")(0)
end if
Rs("TotalUsers")=TotalUsers
Rs("TotalTopics")=TotalTopics
Rs("TotalPosts")=TotalPosts
Rs("NewestUserName")=NewestUserName
Execute("update ["&TablePrefix&"Forums] Set TodayPosts=0")
Rs("DaysUsers")=Rs("DaysUsers")+int(DaysUsers)
Rs("DaysTopics")=Rs("DaysTopics")+int(DaysTopics)
Rs("DaysPosts")=Rs("DaysPosts")+int(DaysPosts)
Rs("DateCreated")=date()
else
Rs("TotalUsers")=Rs("TotalUsers")+DaysUsers
Rs("TotalTopics")=Rs("TotalTopics")+DaysTopics
Rs("TotalPosts")=Rs("TotalPosts")+DaysPosts
Rs("DaysUsers")=Rs("DaysUsers")+DaysUsers
Rs("DaysTopics")=Rs("DaysTopics")+DaysTopics
Rs("DaysPosts")=Rs("DaysPosts")+DaysPosts
end if
Rs.update
Rs.close
End Sub
Sub UpForumMostRecent(ForumID)
sql="Select top 1 * from ["&TablePrefix&"Threads] where ForumID="&ForumID&" and Visible=1 order by LastTime DESC"
Set Rs2=Execute(sql)
if Rs2.Eof then Exit sub
MostRecentThreadID=Rs2("ThreadID")
MostRecentPostSubject=Rs2("Topic")
MostRecentPostAuthor=Rs2("LastName")
MostRecentPostDate=Rs2("LastTime")
Rs2.close
Set Rs2 = Nothing
Execute("update ["&TablePrefix&"Forums] Set MostRecentThreadID="&MostRecentThreadID&",MostRecentPostSubject='"&MostRecentPostSubject&"',MostRecentPostAuthor='"&MostRecentPostAuthor&"',MostRecentPostDate='"&FormatTime(MostRecentPostDate)&"' where ForumID="&ForumID&"")
End Sub
Sub UpdateThreadStatic(ThreadID)
TotalReplies=Execute("select count(PostID) from ["&TablePrefix&"Posts] where ThreadID="&ThreadID&" and ParentID>0 and Visible=1")(0)
DeletedCount=Execute("select count(PostID) from ["&TablePrefix&"Posts] where ThreadID="&ThreadID&" and Visible=2")(0)
HiddenCount=Execute("select count(PostID) from ["&TablePrefix&"Posts] where ThreadID="&ThreadID&" and Visible=0")(0)
Visible=Execute("select Visible from ["&TablePrefix&"Posts] where ThreadID="&ThreadID&" and ParentID=0")(0)
Execute("update ["&TablePrefix&"Threads] set TotalReplies="&TotalReplies&",DeletedCount="&DeletedCount&",HiddenCount="&HiddenCount&",Visible="&Visible&" where ThreadID="&ThreadID&"")
End Sub
Sub SendMail(MailAddRecipient,MailSubject,MailBody)
if MailAddRecipient=""or MailSubject="" or MailBody="" then Exit Sub
on error resume next
MailSubject="("&SiteConfig("SiteName")&")"&MailSubject
MailBody=MailBody&"<br><br><br><a target=_blank href="&SiteConfig("SiteUrl")&"/Default.asp>"&SiteConfig("SiteName")&"</a> 管理团队<br><br><a target=_blank href=http://www.bbsxp.com>BBSXP</a> © 1998-"&year(now)&" <a target=_blank href=http://www.yuzi.net>YUZI Corporation.</a>"
if SiteConfig("SelectMailMode")="JMail.Message" then
Set JMail=Server.CreateObject("JMail.Message")
JMail.Charset=BBSxpCharset
JMail.ContentType = "text/html"
'JMail.ContentType = "text/plain"
JMail.From = SiteConfig("SmtpServerMail")
AddRecipientArray=split(MailAddRecipient,";")
For i=0 to Ubound(AddRecipientArray)
if ""&AddRecipientArray(i)&""<>"" then JMail.AddRecipient AddRecipientArray(i)
Next
JMail.Subject = MailSubject
JMail.Body = MailBody
JMail.MailServerUserName = SiteConfig("SmtpServerUserName")
JMail.MailServerPassword = SiteConfig("SmtpServerPassword")
JMail.Send SiteConfig("SmtpServer")
Set JMail=nothing
elseif SiteConfig("SelectMailMode")="Persits.MailSender" then
Set AspEmail = Server.CreateObject("Persits.MailSender")
AspEmail.Host = SiteConfig("SmtpServer")
AspEmail.Username = SiteConfig("SmtpServerUserName")
AspEmail.Password = SiteConfig("SmtpServerPassword")
AspEmail.From = SiteConfig("SmtpServerMail")
AddRecipientArray=split(MailAddRecipient,";")
For i=0 to Ubound(AddRecipientArray)
if ""&AddRecipientArray(i)&""<>"" then AspEmail.AddAddress AddRecipientArray(i)
Next
AspEmail.Subject = MailSubject
AspEmail.Body = MailBody
AspEmail.IsHTML = true
AspEmail.Charset = BBSxpCharset
AspEmail.Send
Set AspEmail=Nothing
elseif SiteConfig("SelectMailMode")="CDO.Message" then
Set CDO=Server.CreateObject("CDO.Message")
CDO.From = SiteConfig("SmtpServerMail")
CDO.To = MailAddRecipient
CDO.Subject = MailSubject
CDO.HtmlBody = MailBody
'CDO.TextBody = MailBody
CDO.HTMLBodyPart.Charset=BBSxpCharset
CDO.Send
Set CDO=Nothing
end if
If Err Then Response.Write ""&MailAddRecipient&"邮件发送失败！错误原因：" & Err.Description & "<br>"
On Error GoTo 0
End Sub
Sub LoadingEmailXml(emailType)
Set EmailsXMLDOM = Server.CreateObject("Microsoft.XMLDOM")
EmailsXMLDOM.Load(Server.MapPath("Xml/emails.xml"))
MailSubject = EmailsXMLDOM.documentElement.selectSingleNode("//emails/"&emailType&"/subject").Text
Mailbody = EmailsXMLDOM.documentElement.selectSingleNode("//emails/"&emailType&"/body").Text
Mailbody = Replace(Mailbody,CHR(10),"<br>")
Set EmailsXMLDOM = Nothing
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CheckUser(UserName)
if Len(UserName) < SiteConfig("UserNameMinLength") then CheckUser=CheckUser&"<li>您的用户名长度不能少于 "&SiteConfig("UserNameMinLength")&" 个字节</li>"
if Len(UserName) > SiteConfig("UserNameMaxLength") then CheckUser=CheckUser&"<li>您的用户名长度不能超过 "&SiteConfig("UserNameMaxLength")&" 个字节</li>"
ErrorChar=array(" ","⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -