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>
<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>
<TD align= "Right" >
<b>date posted:</b> <%=rs ("M_entrydate")%>
</td>
</tr>
<tr>
<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>
<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>
<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>
<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>
<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>
<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>
