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
-----------------------------------
1<html>
2<head><title>Discussion</title></head>
3<frameset rows="30,*">
4<frame frameborder="no" marginheight="2" marginwidth="5" scrolling="no" src="discusslogo.asp"/>
5<frame name="topframe" src="discussframes.asp"/>
6</frameset>
7</html>
-----------------------------------------
Listing 2.0 - discussframes.asp
-------------------------------------------------
1
2page = TRIM( request( "pg" ) )
3addm = TRIM( request( "addm" ) )
4email = TRIM( request( "email" ) )
5subject = TRIM( request( "subject" ) )
6message = TRIM( request( "message" ) )
7
8IF addm <> "" THEN
9IF email = "" THEN
10showError "You did not enter your email address", "post.asp"
11END IF
12IF subject = "" THEN
13showError "You did not enter a subject for your message", "post.asp"
14END IF
15IF message = "" THEN
16showError "You did not enter a message", "post.asp"
17END IF
18IF INSTR( email, "." ) = 0 OR INSTR( email, "@" ) = 0 THEN
19showError "You did not enter a valid email address", "post.asp"
20END IF
21
22
23readyDBCon
24Set RS = Server.CreateObject( "ADODB.Recordset" )
25RS.ActiveConnection = Con
26RS.CursorType = adOpenStatic
27RS.LockType = adLockOptimistic
28RS.Open "SELECT * FROM messages WHERE 1<>1", Con
29RS.AddNew
30RS( "m_email" ) = email
31RS( "m_subject" ) = subject
32RS( "m_message" ) = message
33RS( "m_reply" ) = addm
34RS.Update
35RS.Close
36IF addm <> "-1" THEN
37Con.Execute "UPDATE messages SET m_numreplies = m_numreplies+1 WHERE m_id=" & addm
38END IF
39END IF
1<html>
2<head><title>frameset</title>
3<frameset rows="300,*">
4<frame frameborder="no" marginheight="3" marginwidth="5" scrolling="yes" src="messagelist.asp?
5pg=```
6=page
7```"/>
8<frame frameborder="no" marginheight="0" marginwidth="0" name="message" scrolling="auto" src="message.asp?id=```
9=addm
10```&pg=```
11=page
12```"/>
13</frameset>
14</head></html>
------------------------------------------------------
Listing 3.0 - discussfuncs.asp
-------------------------------------------------------
1
2dbPath = "d:\discuss.mdb"
3messagesApage = 5
4
5''''''''''''''''''''
6' Define Constants
7''''''''''''''''''''
8adOpenStatic = 3
9adLockOptimistic = 3
10
11
12'''''''''''''''''''''''''''
13' Declare Global Variables
14'''''''''''''''''''''''''''
15DIM Con
16
17
18SUB readyDBCon
19IF Con = "" THEN
20Set Con = Server.CreateObject( "adodb.Connection" )
21Con.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & dbPath
22END IF
23END SUB
24
25
26
27FUNCTION showUser( theEmail )
28whereA = INSTR( theEmail, "@" )
29showUser = Server.HTMLEncode( LEFT( theEmail, whereA - 1 ) )
30END FUNCTION
31
32
33
34FUNCTION formatOutput( theText )
35theText = Server.HTMLEncode( theText )
36theText = REPLACE( theText, vbNewline & vbNewline, "
<p>" )
theText = REPLACE( theText, vbNewline, "<br/>" )
formatOutput = theText
END FUNCTION
sub showError( errorMessage, backpage )
1<html>
2<head><title>Problem</title></head>
3<body bgcolor="lightyellow">
4<center>
5<table border="0" cellpadding="4" cellspacing="0" width="400">
6<tr>
7<td>
8<font color="red" face="Arial" size="4"><b>
9There was a problem with the message you entered:</b></font>
10<p><font color="blue" face="Arial" size="3"><b>
=errorMessage
1<form action="```
2=backpage
3```" method="post">
for each thing in Request.Form
1<input name="```
2=thing
3```" type="hidden" value="```
4=Server.HTMLEncode( Request(
5thing ) )
6```"/>
next
1<input type="submit" value="Back"/>
2</form>
3</p></td>
4</tr>
5</table>
6</center></body>
7
Response.End
end sub
1
2
3
4
5
6
7
8
9
10Listing 4.0 - discusslogo.asp
11\-------------------------------------------
12<html>
13<head><title>logo</title></head>
14<body bgcolor="darkgreen" marginheight="0" topmargin="0">
15<table border="0" cellpadding="0" cellspacing="0" width="100%">
16<tr>
17<td>
18<font color="#ffffff" face="Arial" size="2"><b>Microsoft Access Forum</b></font>
19</td>
20</tr>
21</table>
22</body>
23</html>
24
25
26
27
28
29
30
31
32
33
34
35
36
37Listing 5.0 - message.asp
38\------------------------------------
39<!-- #INCLUDE FILE="discussfuncs.asp" -->
id = TRIM( Request( "id" ) )
IF id = "-1" THEN id = ""
page = TRIM( Request( "pg" ) )
1
2<html>
3<head><title>message</title></head>
4<body bgcolor="#ffffff">
5
IF id = "" THEN
1<table border="0" cellpadding="0" cellspacing="0" height="100%" width="100%">
2<tr>
3<td align="center" valign="center">
4<font color="blue" face="Arial" size="3">
5<b>Select a message to read by clicking on one of the subjects above</b>
6</font>
7</td>
8</tr>
9</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
1<table bgcolor="yellow" border="0" cellpadding="2" cellspacing="0" width="100%">
2<tr>
3<td>
4<b>Author:</b> ```
5=showUser( RS( "m_email" ) )
| ``` =formatOutput( RS( "m_message" ) ) ``` |
RS.MoveNext
WEND
END IF
1
2</body>
3</html>
4\----------------------------------------
5
6
7
8
9
10
11
12
13
14
15
16
17
18Listing 6.0 - messagelist.asp
19\-------------------------------------------
20<!-- #INCLUDE FILE="discussfuncs.asp" -->
21<html>
22<head><title>Message List</title></head>
23<body bgcolor="#eeeeee">
24<table border="0" cellpadding="4" cellspacing="0" width="100%">
25<tr>
26<td align="right">
27<a href="post.asp" target="topframe"><font face="Arial" size="2"><i>Post New
28Message</i></font></a>
29</td>
30</tr>
31</table>
32
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
1<font face="Arial">There are no messages</font>
ELSE
1<table border="0" cellpadding="4" cellspacing="0" width="100%">
2<tr>
3<td>
4<font color="darkgreen" size="2"><b>AUTHOR</b></font>
5</td>
6<td>
7<font color="darkgreen" size="2"><b>SUBJECT</b></font>
8</td>
9<td>
10<font color="darkgreen" size="2"><b>REPLIES</b></font>
11</td>
12<td>
13<font color="darkgreen" size="2"><b>DATE POSTED</b></font>
14</td>
15</tr>
WHILE NOT RS.EOF and counter < RS.PageSize
1<tr>
2<td><font size="2">```
3=showUser( RS( "m_email" ) )
4```</font></td>
5<td><a )="" =page="" ```"="" ```&pg="```" href="message.asp?id=```
6=RS( " m_id"="" target="message"><font size="2">```
7=Server.HTMLEncode( RS( "m_subject" ) )
8```</font></a></td>
9<td>
10<font size="2">```
11=RS( "m_numreplies" )
12``` </font>
IF cINT( RS( "m_numreplies" ) ) > 0 THEN
1<a )="" =page="" ```#replies"="" ```&pg="```" href="message.asp?id=```
2=RS( " m_id"="" target="message"><font size="2">view</font></a>
END IF
1</td>
2<td><font size="2">```
3=RS( "m_entrydate" )
4```</font></td>
5</tr>
counter = counter+1
RS.MoveNext
WEND
1</table>
IF RS.PageCount > 1 THEN
1<p><font color="#666666" size="2">View Page: </font>
FOR i = 1 to RS.PageCount
IF i = cINT( page ) THEN
1<font size="2"><b>```
2=i
3```</b></font>
ELSE
1<a href="discussframes.asp?pg=```
2=i
3```" target="topframe"><font size="2">```
4=i
5```</font></a>
END IF
NEXT
END IF
END IF
RS.Close
Con.Close
1</p></body>
2</html>
3\----------------------------------------------
4
5
6
7
8
9
10
11Listing 7.0 - post.asp
12\-------------------------------
page = TRIM( Request( "pg" ) )
id = TRIM( Request( "id" ) )
email = TRIM( Request( "email" ) )
subject = TRIM( Request( "subject" ) )
message = TRIM( Request( "message" ) )
1<html>
2<head>
3<title>Post</title>
4</head>
5<body bgcolor="#000000">
6<form action="discussframes.asp" method="post" target="topframe">
7<input name="pg" type="hidden" value="```
8=page
9```"/>
IF id = "" THEN
1<input name="addm" type="hidden" value="-1"/>
ELSE
1<input name="addm" type="hidden" value="```
2=id
3```"/>
END IF
1
2
3<center>
4<table border="0" cellpadding="4" cellspacing="0" width="640">
5<tr>
6<td align="right" nowrap="">
7<font color="yellow" face="Arial" size="2"><b>Your Email Address:</b></font>
8</td>
9<td>
10<input maxlength="255" name="email" size="60" value="```
11=Server.HTMLEncode( email )
12```"/>
13</td>
14</tr>
15<tr>
16<td align="right">
17<font color="yellow" face="Arial" size="2"><b>Message Subject:</b></font>
18</td>
19<td>
20<input maxlength="50" name="subject" size="60" value="```
21=Server.HTMLEncode( subject )
22```"/>
23</td>
24</tr>
25<tr>
26<td align="right" valign="top">
27<font color="yellow" face="Arial" size="2"><b>Message:</b></font>
28</td>
29<td>
30<textarea cols="60" name="message" rows="13" wrap="virtual"><%=Server.HTMLEncode( message )%
31></textarea>
32</td>
33</tr>
34<tr>
35<td align="right" colspan="2">
36<table border="0" cellpadding="2" cellspacing="0">
37<tr>
38<td>
39<input style="color:blue;font-family:Arial;font-
40weight:bold" type="submit" value="Post Message"/>
41</td>
42</tr></table></td></tr></table></center></form>
43<form action="discussframes.asp" target="topframe">
44<td>
45<input style="color:blue;font-family:Arial;font-
46weight:bold" type="submit" value="Cancel Message"/>
47</td>
48
49
50
51
52
53</form></body>
54</html></html></p>