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

Source: Internet
Author: User
Tags date include trim valid email address access database microsoft access database
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
-------------------------------------------------
<!--#INCLUDE file= "discussfuncs.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
------------------------------------
<!--#INCLUDE file= "discussfuncs.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
-------------------------------------------
<!--#INCLUDE file= "discussfuncs.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>


Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

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

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

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

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.