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 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>
'''''''''''''''''''''''''''
' 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 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
%>
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.