Use Access to make a full-featured forum (source program)

Developer on Alibaba Coud: Build your first app with APIs, SDKs, and tutorials on the Alibaba Cloud. Read more ＞

To view a live demonstration of this forum, click View Demo.
To create is forum on your server, you'll need to create a Microsoft Access Database named
Discuss.mdb. You'll 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
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

-----------------------------------
<frameset rows= "30,*" >
<frame frameborder= "No" scrolling= "no" src= "discusslogo.asp" marginheight=2 marginwidth=5>
<frame name= "Topframe" src= "discussframes.asp" >
</frameset>
-----------------------------------------

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 don't enter your email address", "post.asp"
End IF
IF subject = "" THEN
ShowError "You did don't enter a subject for your message", "post.asp"
End IF
IF message = "" THEN
ShowError "You did don't enter a message", "post.asp"
End IF
IF INSTR (email, ".") = 0 OR INSTR (email, "@") = 0 THEN
ShowError "You did don't 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 rows= "300,*" >
<frame marginheight= "3" marginwidth= "5" frameborder= "no" scrolling= "yes" src= "messagelist.asp"?
Pg=<%=page%> ">
<frame name= "message" marginwidth= "0" marginheight= "0" frameborder= "no" scrolling= "Auto"
src= "Message.asp?id=<%=addm%>&pg=<%=page%>" >
</frameset>

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

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, "<p>")
TheText = REPLACE (TheText, vbNewLine, "<br>")
Formatoutput = TheText
End FUNCTION

Sub ShowError (errormessage, Backpage)
%>
<body bgcolor= "Lightyellow" >
<center>
<table width= "border=0" cellpadding=4 cellspacing=0>
<tr>
<td>
<font face= "Arial" size= "4" color= "Red" ><b>
There is a problem with the message for you entered:</b></font>
<p><font face= "Arial" size= "3" color= "Blue" ><b>
<%=errormessage%>. Please click the button below to correct this problem</b></font>
<form method= "POST" action= "<%=backpage%>" >
<%
For each thing in Request.Form
%>
<input name= "<%=thing%>" type= "hidden" value= "<%=server.htmlencode (
Thing))%> ">
<%
Next
%>
<input type= "Submit" value= "Back" >
</form>

</td>
</tr>
</table>
</body>
<%
Response.End
End Sub
%>

Listing 4.0-discusslogo.asp
-------------------------------------------
<body bgcolor= "Darkgreen" marginheight=0 topmargin=0>

<table border=0 cellpadding=0 cellspacing=0 width= "100%" >
<tr>
<td>
<font face= "Arial" size= "2" color= "#ffffff" ><b>microsoft Access forum</b></font>
</td>
</tr>
</table>

</body>

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

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

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

<body bgcolor= "#ffffff" >

<%
IF id = "" THEN
%>
<table width= "100%" height= "100%" cellpadding=0 cellspacing=0 border=0>
<tr>
&LT;TD valign= "center" align= "Center" >
<font face= "Arial" size= "3" color= "Blue" >
<b>select a message to read by clicking on one of the subjects above</b>
</font>
</td>
</tr>
</table>
<%
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
%>
<table width= "100%" border=0 cellpadding=2 cellspacing=0 bgcolor= "Yellow" >
<tr>
<td>
<b>Author:</b> <%=showuser (RS ("M_email"))%>
</td>
&LT;TD align= "Right" >
<b>date posted:</b> <%=rs ("M_entrydate")%>
</td>
</tr>
<tr>
&LT;TD colspan=2>
<b>Subject:</b> <%=server.htmlencode (RS ("M_subject"))%>
</td>
</tr>
</table>
<table width= "100%" cellpadding=4 cellspacing=0 border=0>
<tr>
<td>
<font face= "Arial" size= "2" >
<%=formatoutput (RS ("M_message"))%>
</font>
<P>
<a href= "post.asp?id=<%=id%>&pg=<%=page%>" target= "Topframe" >reply to this
Message</a>
</td>
</tr>
</table>
<% if Mcount = 0 THEN%>
<a name= "replies" > </a>
<% End IF%>
<%
Rs. MoveNext
Wend
End IF
%>

</body>
----------------------------------------

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

<body bgcolor= "#eeeeee" >

<table width= "100%" border=0 cellpadding=4 cellspacing=0>
<tr>
&LT;TD align= "Right" >
<a href= "post.asp" target= "Topframe" ><font face= "Arial" size= "2" ><i>post New
Message</i></font></a>
</td>
</tr>
</table>

<%
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
%>
<font face= "Arial" >there are no messages</font>
<%
ELSE
%>
<table width= "100%" border=0 cellpadding=4 cellspacing=0>
<tr>
<td>
<font size= "2" color= "Darkgreen" ><b>AUTHOR</b></font>
</td>
<td>
<font size= "2" color= "Darkgreen" ><b>SUBJECT</b></font>
</td>
<td>
<font size= "2" color= "Darkgreen" ><b>REPLIES</b></font>
</td>
<td>
<font size= "2" color= "Darkgreen" ><b>date posted</b></font>
</td>
</tr>
<%
While not RS. EOF and Counter < RS. PageSize
%>
<tr>
<td><font size= "2" ><%=showuser (RS ("M_email"))%></font></td>
<td><a href= "Message.asp?id=<%=rs (" m_id ")%>&pg=<%=page%>" target= "message" ><font "
Size= "2" ><%=server.htmlencode (RS ("M_subject"))%></font></a></td>
<td>
<font size= "2" ><%=rs ("M_numreplies")%> </font>
<% IF CINT (RS ("M_numreplies")) > 0 THEN%>
<a href= "Message.asp?id=<%=rs (" m_id ")%>&pg=<%=page%> #replies"
target= "message" ><font size= "2" >view</font></a>
<% End IF%>
</td>
<td><font size= "2" ><%=rs ("M_entrydate")%></font></td>
</tr>
<%
Counter = counter+1
Rs. MoveNext
Wend
%>
</table>
<%
IF RS. PageCount > 1 THEN
%>
<p><font size= "2" color= "#666666" >view Page: </font>
<%
For i = 1 to RS. PageCount
IF i = CINT (page) THEN
%>
<font size= "2" ><b><%=i%></b></font>
<%
ELSE
%>
<a href= "discussframes.asp?pg=<%=i%>" target= "Topframe" ><font size= "2" ><%=i%></font ></a>
<%
End IF
NEXT
End IF
End IF
Rs. Close
Con.close
%>
</body>
----------------------------------------------

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 '))
%>
<HTML>
<HEAD>
<TITLE>Post</TITLE>
</HEAD>
<body bgcolor= "#000000" >

<form method= "POST" action= "discussframes.asp" target= "Topframe" >
<input Name= "PG" type= "hidden" value= "<%=page%>" >
<% IF id = "" THEN%>
<input name= "ADDM" type= "hidden" value= "-1" >
<% ELSE%>
<input name= "ADDM" type= "hidden" value= "<%=id%>" >
<% End IF%>

<center>
<table width= "640" cellpadding= "4" cellspacing=0 border=0>
<tr>
&LT;TD align= "right" nowrap>
<font face= "Arial" size= "2" color= "yellow" ><b>your Email address:</b></font>
</td>
<td>
<input name= "Email" size= "maxlength=" 255 "value=" <%=server.htmlencode (email)%> ">
</td>
</tr>
<tr>
&LT;TD align= "Right" >
<font face= "Arial" size= "2" color= "Yellow" ><b>message subject:</b></font>
</td>
<td>
<input name= "Subject" size= "maxlength=" value= "<%=server.htmlencode" (subject)%> ">
</td>
</tr>
<tr>
&LT;TD align= ' right ' valign= ' top ' >
<font face= "Arial" size= "2" color= "Yellow" ><b>Message:</b></font>
</td>
<td>
<textarea name= "message" cols= "rows=" wrap= "virtual" ><%=server.htmlencode (message)%
></textarea>
</td>
</tr>
<tr>
&LT;TD align= "right" colspan=2>
<table border=0 cellpadding=2 cellspacing=0>
<tr>
<td>
<input type= "Submit" value= "Post message" style= "color:blue;font-family:arial;font-
Weight:bold ">
</td>
</form>
<form action= "discussframes.asp" target= "Topframe" >
<td>
<input type= "Submit" value= "Cancel Message" style= "color:blue;font-family:arial;font-
Weight:bold ">
</td>
</tr>
</table>
</td>
</tr>
</table>
</BODY>
</HTML>

This article is an English version of an article which is originally in the Chinese language on aliyun.com and is provided for information purposes only. This website makes no representation or warranty of any kind, either expressed or implied, as to the accuracy, completeness ownership or reliability of the article or any translations thereof. If you have any concerns or complaints relating to the article, please send an email, providing a detailed description of the concern or complaint, to info-contact@alibabacloud.com. A staff member will contact you within 5 working days. Once verified, infringing content will be removed immediately.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

Get Started for Free

Sales Support

1 on 1 presale consultation

Chat Contact Sales
After-Sales Support

24/7 Technical Support 6 Free Tickets per Quarter Faster Response

Open a Ticket
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.

Learn More