2008-7-16 00:11
啦啦
用Access制作一个功能完善的论坛（源程序）
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
-----------------------------------
<html>
<head><title>Discussion</title></head>
<frameset rows="30,*">
<frame frameborder="no" scrolling="no" src="discusslogo.asp" marginheight=2 marginwidth=5>
<frame name="topframe" src="discussframes.asp">
</frameset>
</html>
-----------------------------------------
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 not enter your email address", "post.asp"
END IF
IF subject = "" THEN
showError "You did not enter a subject for your message", "post.asp"
END IF
IF message = "" THEN
showError "You did not enter a message", "post.asp"
END IF
IF INSTR( email, "." ) = 0 OR INSTR( email, "@" ) = 0 THEN
showError "You did not 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
%>
<html>
<head><title>frameset</title>
<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>
</html>
------------------------------------------------------
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 )
%>
<html>
<head><title>Problem</title></head>
<body bgcolor="lightyellow">
<center>
<table width="400" border=0 cellpadding=4 cellspacing=0>
<tr>
<td>
<font face="Arial" size="4" color="red"><b>
There was a problem with the message 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( Request(
thing ) )%>">
<%
next
%>
<input type="submit" value="Back">
</form>
</td>
</tr>
</table>
</body>
</head>
<%
Response.End
end sub
%>
Listing 4.0 - discusslogo.asp
-------------------------------------------
<html>
<head><title>logo</title></head>
<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>
</html>
Listing 5.0 - message.asp
------------------------------------
<!-- #INCLUDE FILE="discussfuncs.asp" -->
<%
id = TRIM( Request( "id" ) )
IF id = "-1" THEN id = ""
page = TRIM( Request( "pg" ) )
%>
<html>
<head><title>message</title></head>
<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>
</html>
----------------------------------------
Listing 6.0 - messagelist.asp
-------------------------------------------
<!-- #INCLUDE FILE="discussfuncs.asp" -->
<html>
<head><title>Message List</title></head>
<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>
</html>
----------------------------------------------
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="60" 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="60" maxlength="50" 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="60" rows="13" 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>
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
-----------------------------------
<html>
<head><title>Discussion</title></head>
<frameset rows="30,*">
<frame frameborder="no" scrolling="no" src="discusslogo.asp" marginheight=2 marginwidth=5>
<frame name="topframe" src="discussframes.asp">
</frameset>
</html>
-----------------------------------------
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 not enter your email address", "post.asp"
END IF
IF subject = "" THEN
showError "You did not enter a subject for your message", "post.asp"
END IF
IF message = "" THEN
showError "You did not enter a message", "post.asp"
END IF
IF INSTR( email, "." ) = 0 OR INSTR( email, "@" ) = 0 THEN
showError "You did not 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
%>
<html>
<head><title>frameset</title>
<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>
</html>
------------------------------------------------------
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 )
%>
<html>
<head><title>Problem</title></head>
<body bgcolor="lightyellow">
<center>
<table width="400" border=0 cellpadding=4 cellspacing=0>
<tr>
<td>
<font face="Arial" size="4" color="red"><b>
There was a problem with the message 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( Request(
thing ) )%>">
<%
next
%>
<input type="submit" value="Back">
</form>
</td>
</tr>
</table>
</body>
</head>
<%
Response.End
end sub
%>
Listing 4.0 - discusslogo.asp
-------------------------------------------
<html>
<head><title>logo</title></head>
<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>
</html>
Listing 5.0 - message.asp
------------------------------------
<!-- #INCLUDE FILE="discussfuncs.asp" -->
<%
id = TRIM( Request( "id" ) )
IF id = "-1" THEN id = ""
page = TRIM( Request( "pg" ) )
%>
<html>
<head><title>message</title></head>
<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>
</html>
----------------------------------------
Listing 6.0 - messagelist.asp
-------------------------------------------
<!-- #INCLUDE FILE="discussfuncs.asp" -->
<html>
<head><title>Message List</title></head>
<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>
</html>
----------------------------------------------
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="60" 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="60" maxlength="50" 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="60" rows="13" 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>
页: [1]
查看完整版本: 用Access制作一个功能完善的论坛（源程序）
Powered by Discuz! Archiver 5.5.0 © 2001-2006 Comsenz Inc.