📄 admin_forums.asp
字号:
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """> Last archive date: " & archive_date & "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
thisCat = drs("Cat_ID")
drs.movenext
loop
Response.Write " </form>" & vbNewLine
end if
set drs = nothing
Response.Write " </table>" & vbNewLine & _
" </font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
elseif strForumIDN <> "" then
if request.querystring("confirm") = "" then
Response.Write " <form method=""post"" action=""admin_forums.asp?action=archive&id=" & strForumIDN & "&confirm=no"">" & vbNewLine & _
" <br />" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Archive Topics which are older than:</font> " & vbNewLine & _
" <select name=""archiveolderthan"" size=""1"">" & vbNewLine
for counter = 1 to 6
Response.Write " <option value=""" & DateToStr(DateAdd("m", -counter, now())) & """>" & counter & " Month"
if counter > 1 then response.write("s")
Response.Write "</option>" & vbNewLine
next
Response.Write " <option value=""" & DateToStr(DateAdd("m", -12, now())) & """>One Year</option>" & vbNewLine & _
" </select>" & vbNewLine & _
" " & vbNewLine & _
" <input type=""submit"" value=""Archive"">" & vbNewLine & _
" </form>" & vbNewLine
elseif request.querystring("confirm") = "no" then
Response.Write " <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Are you sure you want to archive these topics?<br /><br />" & vbNewline & _
" <span class=""spnMessageText""><a href=""admin_forums.asp?action=archive&id=" & strForumIDN & "&confirm=yes&date=" & request.form("archiveolderthan") & """>Yes</a></span> | <span class=""spnMessageText""><a href=""admin_forums.asp?action=archive&id=" & strForumIDN & "&confirm=cancel"">No</a></span></font></center><br />" & vbNewLine
elseif request.querystring("confirm") = "yes" then
Call subarchivestuff(request.querystring("date"))
elseif request.querystring("confirm") = "cancel" then
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Archiving Cancelled.</font><br /><br />" & vbNewLine
end if
Response.Write " <br />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
end if
Response.Write " <br />" & vbNewLine & _
" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><a href=""admin_forums.asp"">Back to Forums Administration</a></font></center><br />" & vbNewLine & _
" <br />" & vbNewLine
Case "deletearchive" '######################## DELETE ARCHIVED
Response.Write " <table border=""0"" width=""75%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strCategoryCellColor & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>Administrative Forum Archive Functions</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strForumCellColor & """ valign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><b>Delete archived topics:</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strForumCellColor & """ valign=""top"" align=""center"">" & vbNewLine
strForumIDN = request.querystring("id")
strForumIDN = Server.URLEncode(strForumIDN)
if strForumIDN = "" and request.querystring("confirm") = "" then
Response.Write " <table width=""100%"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Select a forum from which to delete archived topics</font><br /></td>" & vbNewLine & _
" </tr>" & vbNewLine
strSql = "SELECT " & strTablePrefix & "FORUM.CAT_ID, "
strSql = strSql & strTablePrefix & "FORUM.FORUM_ID, "
strSql = strSql & strTablePrefix & "FORUM.F_L_DELETE, "
strSql = strSql & strTablePrefix & "FORUM.F_DELETE_SCHED, "
strSql = strSql & strTablePrefix & "FORUM.F_SUBJECT "
strSql = strSql & " FROM " & strTablePrefix & "FORUM, " & strArchiveTablePrefix & "TOPICS "
strSql = strSql & " WHERE " & strTablePrefix & "FORUM.FORUM_ID = " & strArchiveTablePrefix & "TOPICS.FORUM_ID "
strSql = strSql & " ORDER BY " & strTablePrefix & "FORUM.CAT_ID DESC, " & strTablePrefix & "FORUM.F_SUBJECT DESC"
set drs = my_conn.execute(strsql)
thisCat = 0
thisForum = 0
if drs.eof then
Response.write " <tr>" & vbNewLine & _
" <td colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><b>No Forums Found!</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
else
Response.Write " <tr>" & vbNewLine & _
" <td colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><li><span class=""spnMessageText""><a href=""admin_forums.asp?action=deletearchive&id=-1"">All Forums</a></span></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><li><span class=""spnMessageText""><a href=""javascript:document.delTopic.submit()"">Selected Forums</a></span></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """> </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <form name=""delTopic"" action=""admin_forums.asp"">" & vbNewLine & _
" <input type=""hidden"" value=""deletearchive"" name= ""action"">" & vbNewLine
do until drs.eof
if thisForum <> drs("FORUM_ID") then
thisForum = drs("FORUM_ID")
lastDeleted = drs("F_L_DELETE")
schedDays = drs("F_DELETE_SCHED")
if (IsNull(lastDeleted)) or (lastDeleted = "") then
delete_date = "N/A"
overdue = 0
else
needDelete = (DateAdd("d",schedDays+7,strToDate(lastDeleted)))
if (strForumTimeAdjust > needDelete) and (schedDays > 0) then
overdue = true
delete_date = "<font color=""" & strHiLiteFontColor & """>Deletion Overdue</font>"
else
overdue = false
delete_date = StrToDate(lastDeleted)
end if
end if
if thisCat <> drs("CAT_ID") then
response.write " <tr><td colspan=""2""> </td></tr>"
thisCat = drs("CAT_ID")
end if
Response.Write " <tr>" & vbNewLine & _
" <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><input type=""checkbox"" name=""id"" value=""" & drs("FORUM_ID") & ""
if overdue then Response.Write(" checked")
Response.Write """><span class=""spnMessageText""><a href=""admin_forums.asp?action=deletearchive&id=" & drs("FORUM_ID") & """>" & drs("F_SUBJECT") & "</a></span></font></td>" & vbNewLine & _
" <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """> Last delete date: " & delete_date & "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
drs.movenext
loop
Response.Write " </form>" & vbNewLine
end if
set drs = nothing
Response.Write " </table>" & vbNewLine
elseif request.querystring("id") <> "" and request.querystring("confirm") = "" then
Response.Write " <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Select how many months old the Topics should be that you wish to delete</font></center>" & vbNewLine & _
" <form method=""post"" action=""admin_forums.asp?action=deletearchive&id=" & strForumIDN & "&confirm=no"">" & vbNewLine & _
" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Delete archived Topics which are older than:</font><br />" & vbNewLine & _
" <select name=""archiveolderthan"" size=""1"">" & vbNewLine
for counter = 1 to 6
Response.Write " <option value=""" & DateToStr(DateAdd("m", -counter, now())) & """>" & counter & " Month"
if counter > 1 then Response.Write("s")
Response.Write "</option>" & vbNewLine
next
Response.Write " <option value=""" & DateToStr(DateAdd("m", -12, now())) & """>One Year</option>" & vbNewLine & _
" </select>" & vbNewLine & _
" " & vbNewLine & _
" <input type=""submit"" value=""Delete""></center>" & vbNewLine & _
" </form>" & vbNewLine
elseif request.querystring("id") <> "" and request.querystring("confirm") = "no" then
Response.Write " <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Are you sure you want to delete these topics from the archive?<br /><br />" & vbNewline & _
" <span class=""spnMessageText""><a href=""admin_forums.asp?action=deletearchive&id=" & strForumIDN & "&confirm=yes&date=" & request.form("archiveolderthan") & """>Yes</a></span> | <span class=""spnMessageText""><a href=""admin_forums.asp?action=delete&confirm=false&id=" & strForumIDN & """>No</a></span></font></center><br />" & vbNewLine
elseif strForumIDN <> "" and request.querystring("confirm") = "yes" then
Response.Write " <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>Topics older than " & StrToDate(request.querystring("date")) & " have been deleted from the selected archive forum.</font></center><br />" & vbNewLine
call subdeletearchivetopics(strForumIDN, request.querystring("date"))
end if
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" <br />" & vbNewLine & _
" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><a href=""admin_forums.asp"">Back to Forums Administration</a></font></center><br />" & vbNewLine & _
" <br />" & vbNewLine
end Select
Sub subDeleteArchiveTopics(strForum_id, strDateOlderThan)
Dim fIDSQL
'#### create FORUM_ID clause
rqID = request("id")
'rqID = strForum_id
on error resume next
testID = cLng(rqID)
if err.number = 0 then
if rqID <> "-1" then
fIDSQL = " AND FORUM_ID=" & rqID
else
fIDSQL = ""
end if
err.clear
else
fIDSQL = " AND FORUM_ID IN (" & rqID & ")"
err.clear
end if
on error goto 0
strsql = "DELETE FROM " & strArchiveTablePrefix & "TOPICS WHERE T_LAST_POST < '" & strDateOlderThan & "'" & fIDSQL
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
strsql = "DELETE FROM " & strArchiveTablePrefix & "REPLY WHERE R_DATE < '" & strDateOlderThan & "'" & fIDSQL
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
Call subdoupdates()
End Sub
Sub subArchiveStuff(fdateolderthan)
set Server2 = Server
Server2.ScriptTimeout = 10000
Dim fIDSQL
Dim drs,delRep
Set drs = CreateObject("ADODB.Recordset")
Set delRep = CreateObject("ADODB.Recordset")
Set drs.ActiveConnection = my_conn
'#### create FORUM_ID clause
rqID = request("id")
on error resume next
testID = cLng(rqID)
if err.number = 0 then
if rqID <> "-1" then
fIDSQL = " AND " & strTablePrefix & "TOPICS.FORUM_ID=" & rqID
else
fIDSQL = ""
end if
err.clear
else
fIDSQL = " AND " & strTablePrefix & "TOPICS.FORUM_ID IN (" & rqID & ")"
err.clear
end if
on error goto 0
'#### Get the replies to Archive
strSql = "SELECT T_DATE, " & strTablePrefix & "REPLY.* FROM " & strTablePrefix & "REPLY LEFT OUTER JOIN " & strTablePrefix & "TOPICS " &_
"ON " & strTablePrefix & "REPLY.TOPIC_ID = " & strTablePrefix & "TOPICS.TOPIC_ID " &_
" WHERE T_LAST_POST < '" & fdateolderthan & "'" & fIDSQL
strSQL = strSQL & " AND T_ARCHIVE_FLAG <> 0 "
drs.Open strsql, my_conn, adOpenStatic, adLockOptimistic, adCmdText
'#### Archive the Replies
if drs.eof then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -