📄 common.asp
字号:
<%@ Language = "VBScript" %>
<%
Option Explicit
Response.Buffer = True
' You may need to kill the above 3 setting based on your include situation, but
' if this code is used as is they should work fine.
' Our include files. A trimmer version of adovbs.inc and our config file.
%>
<!-- #INCLUDE file="mini-adovbs.inc" -->
<!-- #INCLUDE file="config.asp" -->
<%
' GLOBAL VAR!!!
Dim cnnForumDC ' Our Data Connection used throughout
'== BEGIN PROCESSOR ============================================================
' This is the processing controller for all pages!
Sub ProcessForumPage(bOpenConnection)
' Speed timer for testing - see bottom of function as well
'Dim PageSpeedTimer
'PageSpeedTimer = Timer()
' Show the pre-forum HTML
Call ShowHeader
' If a Data Connection is requested then provide one
If bOpenConnection Then
Set cnnForumDC = Server.CreateObject("ADODB.Connection")
cnnForumDC.CommandTimeout = 30
cnnForumDC.ConnectionTimeout = 20
cnnForumDC.Open DB_CONNECTIONSTRING, DB_USERNAME, DB_PASSWORD
End If
Call Main
' If a Data Connection was used then tear it down
If bOpenConnection Then
cnnForumDC.Close
Set cnnForumDC = Nothing
End If
' Show the post-forum HTML
Call ShowFooter
' Speed timer for testing - see top of function as well
'Response.Write "<BR><BR>" & Response.Buffer & "<BR>"
'Response.Write Timer() - PageSpeedTimer
If Response.Buffer Then Response.Flush
End Sub
'== END PROCESSOR ==============================================================
'== BEGIN UTILITIES ============================================================
Sub WriteLine(strText)
Response.Write strText & vbCrLf
End Sub
Function Lineify(strInput)
Dim strTemp
strTemp = Server.HTMLEncode(strInput)
strTemp = Replace(strTemp, " ", " ", 1, -1, 1)
strTemp = Replace(strTemp, " ", " ", 1, -1, 1)
strTemp = Replace(strTemp, " ", " ", 1, -1, 1)
strTemp = Replace(strTemp, " ", " ", 1, -1, 1)
strTemp = Replace(strTemp, " ", " ", 1, -1, 1)
strTemp = Replace(strTemp, vbTab, " ", 1, -1, 1)
strTemp = Replace(strTemp, vbCrLf, "<BR>" & vbCrLf, 1, -1, 1)
Lineify = strTemp
End Function
Function FormatTimestampDB(dTimestampToFormat)
' Formats to "m/d/yyyy h:mm:ss AM" format
' Change as appropriate to match your DB
Dim strMonth, strDay, strYear
Dim strHour, strMinute, strSecond
Dim strAMPM
strMonth = Month(dTimestampToFormat)
strDay = Day(dTimestampToFormat)
strYear = Year(dTimestampToFormat)
'strYear = Right(Year(dTimestampToFormat), 2)
strHour = Hour(dTimestampToFormat) Mod 12
If strHour = 0 Then strHour = 12
If Hour(dTimestampToFormat) < 12 Then
strAMPM = "AM"
Else
strAMPM = "PM"
End If
strMinute = Minute(dTimestampToFormat)
If Len(strMinute) = 1 Then strMinute = "0" & strMinute
strSecond = Second(dTimestampToFormat)
If Len(strSecond) = 1 Then strSecond = "0" & strSecond
' "d/m/yyyy h:mm:ss AM" for all those who have had problems.
'FormatTimestampDB = strDay & "/" & strMonth & "/" & strYear & " " & strHour & ":" & strMinute & ":" & strSecond & " " & strAMPM
FormatTimestampDB = strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMinute & ":" & strSecond & " " & strAMPM
End Function
Function FormatTimestampDisplay(dTimestampToFormat)
' Formats to "m/d/yyyy h:mm:ss AM" format
' Change as appropriate to match your display wishes
Dim strMonth, strDay, strYear
Dim strHour, strMinute, strSecond
Dim strAMPM
strMonth = Month(dTimestampToFormat)
strDay = Day(dTimestampToFormat)
strYear = Year(dTimestampToFormat)
'strYear = Right(Year(dTimestampToFormat), 2)
strHour = Hour(dTimestampToFormat) Mod 12
If strHour = 0 Then strHour = 12
If Hour(dTimestampToFormat) < 12 Then
strAMPM = "AM"
Else
strAMPM = "PM"
End If
strMinute = Minute(dTimestampToFormat)
If Len(strMinute) = 1 Then strMinute = "0" & strMinute
strSecond = Second(dTimestampToFormat)
If Len(strSecond) = 1 Then strSecond = "0" & strSecond
' "d/m/yyyy h:mm:ss AM" for all those who have had problems.
'FormatTimestampDB = strDay & "/" & strMonth & "/" & strYear & " " & strHour & ":" & strMinute & ":" & strSecond & " " & strAMPM
FormatTimestampDisplay = strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMinute & ":" & strSecond & " " & strAMPM
End Function
'== END UTILITIES ==============================================================
'== BEGIN DATABASE =============================================================
Function GetRecordset(sRSSource)
Dim objRSGetRecordset
Set objRSGetRecordset = Server.CreateObject("ADODB.RecordSet")
objRSGetRecordset.Open sRSSource, cnnForumDC, adOpenStatic, adLockReadOnly
Set GetRecordset = objRSGetRecordset
'objRSGetRecordset.Close
Set objRSGetRecordset = Nothing
End Function
'== END DATABASE ===============================================================
'== BEGIN DISPLAY ==============================================================
Sub ShowForumLine(iId, sFolderStatus, sName, sDescription, iMessageCount)
Dim strOutput
strOutput = "<A HREF=""./display_forum.asp?fid=" & iId & """><IMG SRC=""./images/folder_" & sFolderStatus & ".gif"" BORDER=""0""></A>"
strOutput = strOutput & " "
strOutput = strOutput & "<A HREF=""./display_forum.asp?fid=" & iId & """><B>" & sName & "</B></A>"
strOutput = strOutput & " -- "
strOutput = strOutput & sDescription
If iMessageCount <> 0 Then
strOutput = strOutput & " ("
strOutput = strOutput & iMessageCount
strOutput = strOutput & " messages)"
End If
WriteLine strOutput & "<BR>"
End Sub
Sub ShowPeriodLine(iForumId, strPeriodType, iPeriodsAgo, iMessageCount)
Dim strOutput
strOutput = strOutput & "<IMG SRC=""./images/blank.gif"" BORDER=""0"">"
strOutput = strOutput & "<A HREF=""./display_forum.asp?fid=" & iForumId & "&pts=" & iPeriodsAgo & """>"
If strPeriodType = "7days" Then
Select Case iPeriodsAgo
Case 0
strOutput = strOutput & "<B><I><FONT SIZE=""-1"">最近7天信息</FONT></I></B></A>"
Case 1
strOutput = strOutput & "<B><I><FONT SIZE=""-1"">8天到14天以前的信息</FONT></I></B></A>"
Case 2
strOutput = strOutput & "<B><I><FONT SIZE=""-1"">15天到天以前的信息</FONT></I></B></A>"
Case Else
strOutput = strOutput & "<B><I><FONT SIZE=""-1"">" & MonthName(Month(DateAdd("m", -(iPeriodsAgo - 3), Date()))) & "'s Posts</FONT></I></B></A>"
End Select
Else
strOutput = strOutput & "<B><I><FONT SIZE=""-1"">" & MonthName(Month(DateAdd("m", -iPeriodsAgo, Date()))) & "'s Posts</FONT></I></B></A>"
End If
If iMessageCount <> 0 Then
strOutput = strOutput & " ("
strOutput = strOutput & iMessageCount
strOutput = strOutput & " messages)"
End If
WriteLine strOutput & "<BR>"
End Sub
Sub ShowMessageLine(iDepth, iId, sSubject, sAuthor, sEmail, sTime, iReplyCount, sPageType, iActiveMessageId)
Dim strOutput
Dim I
strOutput = ""
For I = 0 to iDepth - 1
strOutput = strOutput & "<IMG SRC=""./images/blank.gif"" BORDER=""0"">"
Next 'I
If sPageType = "message" Then
If iActiveMessageId = iId Then
strOutput = strOutput & "<IMG SRC=""./images/arrow.gif"" BORDER=""0"">"
Else
strOutput = strOutput & "<IMG SRC=""./images/blank.gif"" BORDER=""0"">"
End If
Else
strOutput = strOutput & "<IMG SRC=""./images/blank.gif"" BORDER=""0"">"
End If
strOutput = strOutput & "<IMG SRC=""./images/message.gif"" BORDER=""0"" ALIGN=""absmiddle"">"
strOutput = strOutput & " "
strOutput = strOutput & "<A HREF=""./display_message.asp?mid=" & iId & """><FONT SIZE=""-1""><B>" & Replace(Server.HTMLEncode(sSubject), " ", " ", 1, -1, 1) & "</B></FONT></A>"
strOutput = strOutput & " <FONT SIZE=""-1"">by "
strOutput = strOutput & "<I>" & Replace(Server.HTMLEncode(sAuthor), " ", " ", 1, -1, 1) & "</I>"
If sPageType = "message" And sEmail <> "" Then
strOutput = strOutput & " <A HREF=""mailto:" & Server.HTMLEncode(sEmail) & """><IMG SRC=""./images/mail.gif"" BORDER=""0""></A>"
End If
strOutput = strOutput & " at "
strOutput = strOutput & Replace(sTime, " ", " ", 1, -1, 1)
If sPageType = "forum" Then
strOutput = strOutput & " ("
strOutput = strOutput & iReplyCount
strOutput = strOutput & " replies)"
End If
strOutput = strOutput & "</FONT>"
WriteLine strOutput & "<BR>"
End Sub
Sub ShowSearchForm()
%>
<BR><BR>
<FORM ACTION="./search.asp" METHOD="get">
<font "#003300"><b><font color="#003300" style="font-size:12pt">搜索论坛关键词</font></b></font><font style="font-size:12pt" color="#003300"><B>:</B></font><BR>
<INPUT TYPE="text" NAME="keyword">
<INPUT TYPE="submit" VALUE="开始搜索">
<A HREF="search.asp"><IMG SRC="../images/new_search.gif" BORDER="0" ALT="高级快速搜索..."></A>
</FORM>
<%
End Sub
'== END DISPLAY ================================================================
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -