📄 admin_forums.asp
字号:
response.write(" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>No Replies were Archived: none found</font></center><br />" & vbNewLine)
else
i = 0
response.write(" <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>")
do until drs.eof
if isnull(drs("R_LAST_EDITBY")) then
intR_LAST_EDITBY = "NULL"
else
intR_LAST_EDITBY = drs("R_LAST_EDITBY")
end if
strsqlvalues = "" & drs("CAT_ID") & ", " & drs("FORUM_ID") & ", " & drs("TOPIC_ID") & ", " & drs("REPLY_ID")
strsqlvalues = strsqlvalues & ", " & drs("R_AUTHOR") & ", '" & chkstring(drs("R_MESSAGE"),"archive")
strsqlvalues = strsqlvalues & "', '" & drs("R_DATE") & "', '" & drs("R_IP") & "'" & ", " & drs("R_STATUS")
strSqlvalues = strsqlvalues & ", '" & drs("R_LAST_EDIT") & "', " & intR_LAST_EDITBY & ", " & drs("R_SIG") & " "
strsql = "INSERT INTO " & strArchiveTablePrefix & "REPLY (CAT_ID, FORUM_ID, TOPIC_ID, REPLY_ID, R_AUTHOR, R_MESSAGE, R_DATE, R_IP, R_STATUS, R_LAST_EDIT, R_LAST_EDITBY, R_SIG)"
strsql = strsql & " VALUES (" & strsqlvalues & ")"
response.write(".")
'Response.Write(strSql)
'Response.End
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
drs.movenext
i = i + 1
if i = 100 then
response.write("<br />")
i = 0
end if
'#### Delete Original
Loop
response.write("</font>" & vbNewLine)
drs.movefirst
do while not drs.eof
strsql = "select * from " & strTablePrefix & "REPLY WHERE REPLY_ID = " & drs("REPLY_ID")
delrep.Open strsql, my_conn, adOpenStatic, adLockOptimistic, adCmdText
delrep.delete
delrep.close
drs.movenext
loop
response.write(" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>All replies to Topics older than " & strToDate(fdateolderthan) & " were archived</font></center><br />" & vbNewLine)
end if
'#### Update FORUM archive date
strsql = "UPDATE " & strTablePrefix & "FORUM SET F_L_ARCHIVE= '" & fdateolderthan & "'"
on error resume next
testID = cLng(rqID)
if err.number = 0 then
if rqID <> "-1" then
strSQL = strSql & " WHERE FORUM_ID=" & rqID
end if
err.clear
else
strSQL = strSql & " WHERE FORUM_ID IN (" & rqID & ")"
err.clear
end if
on error goto 0
' strSQL = strSQL & " AND T_ARCHIVE_FLAG <> 0 "
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
'#### Get the TOPICS to Archive
strsql = "SELECT CAT_ID,FORUM_ID,TOPIC_ID,T_SUBJECT,T_AUTHOR,T_REPLIES,T_UREPLIES,T_VIEW_COUNT,T_LAST_POST,T_DATE,T_LAST_POSTER,T_IP,T_LAST_POST_AUTHOR,T_LAST_POST_REPLY_ID,T_LAST_EDIT,T_LAST_EDITBY,T_STICKY,T_SIG,T_MESSAGE FROM " & strTablePrefix & "TOPICS WHERE T_LAST_POST < '" & fdateolderthan & "'" & fIDSQL
strSQL = strSQL & " AND T_ARCHIVE_FLAG <> 0 "
set drs = my_conn.execute(strsql)
'#### Archive the Topics
if drs.eof then
response.write(" <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>No Topics were Archived: none found</font></center><br />" & vbNewLine)
else
i = 0
do until drs.eof
strSQL = "SELECT TOPIC_ID FROM " & strArchiveTablePrefix & "TOPICS WHERE TOPIC_ID=" & drs("TOPIC_ID")
set rsTcheck = my_conn.execute(strSQL)
if isnull(drs("T_LAST_EDITBY")) then
intT_LAST_EDITBY = "NULL"
else
intT_LAST_EDITBY = drs("T_LAST_EDITBY")
end if
if isnull(drs("T_LAST_POST_REPLY_ID")) then
intT_LAST_POST_REPLY_ID = "NULL"
else
intT_LAST_POST_REPLY_ID = drs("T_LAST_POST_REPLY_ID")
end if
if isnull(drs("T_UREPLIES")) then
intT_UREPLIES = "NULL"
intT_UREPLIEScnt = 0
else
intT_UREPLIES = drs("T_UREPLIES")
intT_UREPLIEScnt = drs("T_UREPLIES")
end if
if rsTcheck.eof then
err.clear
strsqlvalues = "" & drs("CAT_ID") & ", " & drs("FORUM_ID") & ", " & drs("TOPIC_ID") & ", " & 0
strsqlvalues = strsqlvalues & ", '" & chkstring(drs("T_SUBJECT"),"archive") & "', '" & chkstring(drs("T_MESSAGE"),"archive")
strsqlvalues = strsqlvalues & "', " & drs("T_AUTHOR") & ", " & drs("T_REPLIES") & ", " & intT_UREPLIES & ", " & drs("T_VIEW_COUNT")
strsqlvalues = strsqlvalues & ", '" & drs("T_LAST_POST") & "', '" & drs("T_DATE") & "', " & drs("T_LAST_POSTER")
strsqlvalues = strsqlvalues & ", '" & drs("T_IP") & "', " & drs("T_LAST_POST_AUTHOR") & ", " & intT_LAST_POST_REPLY_ID & ", '" & drs("T_LAST_EDIT")
strsqlvalues = strsqlvalues & "', " & intT_LAST_EDITBY & ", " & drs("T_STICKY") & ", " & drs("T_SIG") & " "
strsql = "INSERT INTO " & strArchiveTablePrefix & "TOPICS (CAT_ID, FORUM_ID, TOPIC_ID, T_STATUS, T_SUBJECT, T_MESSAGE, T_AUTHOR, T_REPLIES, T_UREPLIES, T_VIEW_COUNT, T_LAST_POST, T_DATE, T_LAST_POSTER, T_IP, T_LAST_POST_AUTHOR, T_LAST_POST_REPLY_ID, T_LAST_EDIT, T_LAST_EDITBY, T_STICKY, T_SIG)"
strsql = strsql & " VALUES (" & strsqlvalues & ")"
'Response.Write strSql
'Response.End
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
msg = " <center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>All topics older than " & strToDate(fdateolderthan) & " were archived</font></center><br />" & vbNewLine
else
strsql = "UPDATE " & strArchiveTablePrefix & "TOPICS SET " &_
"T_STATUS = " & 0 &_
", T_SUBJECT = '" & chkstring(drs("T_SUBJECT"),"archive") & "'" &_
", T_MESSAGE = '" & chkstring(drs("T_MESSAGE"),"archive") & "'" &_
", T_REPLIES = T_REPLIES + " & drs("T_REPLIES") &_
", T_UREPLIES = T_UREPLIES + " & intT_UREPLIEScnt &_
", T_VIEW_COUNT = T_VIEW_COUNT + " & drs("T_VIEW_COUNT") &_
", T_LAST_POST = '" & drs("T_LAST_POST") & "'" &_
", T_LAST_POST_AUTHOR = " & drs("T_LAST_POST_AUTHOR") &_
", T_LAST_POST_REPLY_ID = " & intT_LAST_POST_REPLY_ID & _
", T_LAST_EDIT = '" & drs("T_LAST_EDIT") & "'" & _
", T_LAST_EDITBY = " & intT_LAST_EDITBY & _
", T_STICKY = " & drs("T_STICKY") & _
", T_SIG = " & drs("T_SIG") & _
" WHERE TOPIC_ID = " & drs("TOPIC_ID")
response.write(" <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>." & vbNewLine)
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
msg = " <br /><center>Topic exists, Stats Updated......</center></font>" & vbNewLine
end if
Response.Write msg
'#### Delete originals
if i > 100 then
i = 0
response.write(" <br />" & vbNewLine)
end if
i = i + 1
'## Forum_SQL - Delete any subscriptions to this topic
strSql = "DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS "
strSql = strSql & " WHERE TOPIC_ID = " & drs("TOPIC_ID")
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
drs.movenext
Loop
drs.close
strSql = "DELETE FROM " & strTablePrefix & "TOPICS WHERE T_LAST_POST < '" & fdateolderthan & "' " & fIDSQL
strSqL = strSqL & " AND T_ARCHIVE_FLAG <> 0 "
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
End if
Call subdoupdates()
'response.write(" <br /><center><a href=""admin_forums.asp"">Click Here</a> to return to Forums Delete/Archive Admin</center><br />" & vbNewLine)
End Sub
Sub subdeletestuff(fstrid)
Dim fIDSQL
'#### create FORUM_ID clause
rqID = request("id")
on error resume next
testID = cLng(rqID)
if err.number = 0 then
if rqID <> "-1" then
fIDSQL = " WHERE FORUM_ID=" & rqID
else
fIDSQL = ""
end if
err.clear
else
fIDSQL = " WHERE FORUM_ID IN (" & rqID & ")"
err.clear
end if
on error goto 0
strsql = "DELETE FROM " & strTablePrefix & "TOPICS " & fIDSQL
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
strsql = "DELETE FROM " & strTablePrefix & "REPLY " & fIDSQL
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
'#### Update FORUM last delete posts date
strsql = "UPDATE " & strTablePrefix & "FORUM SET F_L_DELETE= '" & DateToStr(now()) & "'"
strsql = strsql & fIDSQL
my_conn.execute(strsql),,adCmdText + adExecuteNoRecords
Call subdoupdates()
End Sub
Sub subdoupdates()
'#### 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 & "FORUM.FORUM_ID=" & rqID
fIDSQL2 = " WHERE " & strTablePrefix & "TOPICS.FORUM_ID=" & rqID
else
fIDSQL = ""
fIDSQL2 = ""
end if
err.clear
else
fIDSQL = " AND " & strTablePrefix & "FORUM.FORUM_ID IN (" & rqID & ")"
fIDSQL2 = " WHERE " & strTablePrefix & "TOPICS.FORUM_ID IN (" & rqID & ")"
err.clear
end if
on error goto 0
response.write " <table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" colspan=""2""><p><b><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>Updating Counts</font></b><br /></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right"" valign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>Topics:</font></td>" & vbNewLine & _
" <td valign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>"
set rs = Server.CreateObject("ADODB.Recordset")
set rs1 = Server.CreateObject("ADODB.Recordset")
'## Forum_SQL - Get contents of the Forum table related to counting
strSql = "SELECT FORUM_ID, F_TOPICS FROM " & strTablePrefix & "FORUM WHERE F_TYPE <> 1 " & fIDSQL
rs.Open strSql, my_Conn
if not(rs.EOF or rs.BOF) then
rs.MoveFirst
i = 0
do until rs.EOF
i = i + 1
'## Forum_SQL - count total number of topics in each forum in Topics table
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -