一聚教程网:一个值得你收藏的教程网站

热门教程

用Access制作一个功能完善的论坛(源程序)

时间:2022-07-02 21:20:48 编辑:袖梨 来源:一聚教程网

To view a live demonstration of this forum, click View Demo.
To create this forum on your server, you will need to create a Microsoft Access Database named
discuss.mdb. You will also need to create a single table in this database named messages that has the
following fields:

m_id -- An autonumber field
m_email -- A text field
m_subject -- A text field
m_message -- A Memo field
m_entrydate -- A Date/Time field with default value of NOW()
m_numReplies -- A Number field with default value of 0
m_reply -- A Number field with default value of -1




Listing 1.0 - discuss.asp

-----------------------------------

Discussion





-----------------------------------------









Listing 2.0 - discussframes.asp
-------------------------------------------------

<%
page = TRIM( request( "pg" ) )
addm = TRIM( request( "addm" ) )
email = TRIM( request( "email" ) )
subject = TRIM( request( "subject" ) )
message = TRIM( request( "message" ) )

IF addm <> "" THEN
IF email = "" THEN
showError "You did not enter your email address", "post.asp"
END IF
IF subject = "" THEN
showError "You did not enter a subject for your message", "post.asp"
END IF
IF message = "" THEN
showError "You did not enter a message", "post.asp"
END IF
IF INSTR( email, "." ) = 0 OR INSTR( email, "@" ) = 0 THEN
showError "You did not enter a valid email address", "post.asp"
END IF


readyDBCon
Set RS = Server.CreateObject( "ADODB.Recordset" )
RS.ActiveConnection = Con
RS.CursorType = adOpenStatic
RS.LockType = adLockOptimistic
RS.Open "SELECT * FROM messages WHERE 1<>1", Con
RS.AddNew
RS( "m_email" ) = email
RS( "m_subject" ) = subject
RS( "m_message" ) = message
RS( "m_reply" ) = addm
RS.Update
RS.Close
IF addm <> "-1" THEN
Con.Execute "UPDATE messages SET m_numreplies = m_numreplies+1 WHERE m_id=" & addm
END IF
END IF
%>

frameset


src="message.asp?id=<%=addm%>&pg=<%=page%>">



------------------------------------------------------







Listing 3.0 - discussfuncs.asp
-------------------------------------------------------
<%
dbPath = "d:discuss.mdb"
messagesApage = 5

''''''''''
' Define Constants  
''''''''''
adOpenStatic = 3
adLockOptimistic = 3


''''''''''''''
' Declare Global Variables
''''''''''''''
DIM Con


SUB readyDBCon
IF Con = "" THEN
Set Con = Server.CreateObject( "adodb.Connection" )
Con.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & dbPath
END IF
END SUB



FUNCTION showUser( theEmail )
whereA = INSTR( theEmail, "@" )
showUser = Server.HTMLEncode( LEFT( theEmail, whereA - 1 ) )
END FUNCTION



FUNCTION formatOutput( theText )
theText = Server.HTMLEncode( theText )
theText = REPLACE( theText, vbNewline & vbNewline, "

" )
theText = REPLACE( theText, vbNewline, "
" )
formatOutput = theText
END FUNCTION



sub showError( errorMessage, backpage )
%>

Problem








There was a problem with the message you entered:


<%=errorMessage%>. Please click the button below to correct this problem


<%
for each thing in Request.Form
%>

<%
next
%>






<%
Response.End
end sub
%>









Listing 4.0 - discusslogo.asp
-------------------------------------------

logo







Microsoft Access Forum

















Listing 5.0 - message.asp
------------------------------------

<%
id = TRIM( Request( "id" ) )
IF id = "-1" THEN id = ""

page = TRIM( Request( "pg" ) )
%>


message


<%
IF id = "" THEN
%>






Select a message to read by clicking on one of the subjects above


<%
ELSE
readyDBCon
SET RS = Server.CreateObject( "ADODB.Recordset" )
RS.ActiveConnection = Con
RS.CursorType = adOpenStatic
RS.Open "select * FROM messages WHERE m_id=" & id & " OR m_reply=" & id & " order by m_id"
mCount = 0
WHILE NOT RS.EOF
%>









Author: <%=showUser( RS( "m_email" ) )%>

Date Posted: <%=RS( "m_entrydate" )%>

Subject: <%=Server.HTMLEncode( RS( "m_subject" ) )%>







<%=formatOutput( RS( "m_message" ) )%>


Reply To This
Message


<% if mcount = 0 THEN %>

<% END IF %>
<%
RS.MoveNext
WEND
END IF
%>



----------------------------------------













Listing 6.0 - messagelist.asp
-------------------------------------------


Message List








Post New
Message
  


<%
page = Request( "pg" )
IF page = "" THEN page = 1


readydbCon

SET RS = Server.CreateObject( "ADODB.Recordset" )
RS.ActiveConnection = Con
RS.CursorType = adOpenStatic
RS.Open "select m_id, m_email, m_subject, m_numreplies, m_entrydate FROM messages WHERE m_reply=-1 ORDER
by m_id DESC"
RS.PageSize = messagesApage
RS.AbsolutePage = page
IF RS.EOF THEN
%>
There are no messages
<%
ELSE
%>







<%
WHILE NOT RS.EOF and counter < RS.PageSize
%>






<%
counter = counter+1
RS.MoveNext
WEND
%>

AUTHOR

SUBJECT

REPLIES

DATE POSTED
<%=showUser( RS( "m_email" ) )%> &pg=<%=page%>" target="message"> size="2"><%=Server.HTMLEncode( RS( "m_subject" ) )%>
<%=RS( "m_numreplies" )%>
<% IF cINT( RS( "m_numreplies" ) ) > 0 THEN %>
&pg=<%=page%>#replies"
target="message">view

<% END IF %>
<%=RS( "m_entrydate" )%>

<%
IF RS.PageCount > 1 THEN
%>

View Page:
<%
FOR i = 1 to RS.PageCount
IF i = cINT( page ) THEN
%>
<%=i%>
<%
ELSE
%>
<%=i%>
<%
END IF
NEXT
END IF
END IF
RS.Close
Con.Close
%>


----------------------------------------------







Listing 7.0 - post.asp
-------------------------------
<%
page = TRIM( Request( "pg" ) )
id = TRIM( Request( "id" ) )
email = TRIM( Request( "email" ) )
subject = TRIM( Request( "subject" ) )
message = TRIM( Request( "message" ) )
%>


Post






<% IF id = "" THEN %>

<% ELSE %>

<% END IF %>




















Your Email Address:



Message Subject:



Message:

















热门栏目