您的位置：首页 → 精文荟萃 → 软件资讯 → 用Access制作一个功能完善的论坛（源程序）

用Access制作一个功能完善的论坛（源程序）

时间：2004/10/7 19:18:00来源：本站整理作者：蓝点我要评论(0)

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



-----------------------------------















-----------------------------------------



















Listing 2.0 - discussframes.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

%>







　　

　　
src="message.asp?id=<%=addm%>&pg=<%=page%>">







------------------------------------------------------















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, "

" )

　　theText = REPLACE( theText, vbNewline, "
" )

　　formatOutput = theText

END FUNCTION







sub showError( errorMessage, backpage )

　　%>

　　

　　

　　

　　

　　

　　

　　　　

　　

　　

There was a problem with the message you entered: 　　　　 　　　　<%=errorMessage%>. Please click the button below to correct this problem 　　　　 　　　　<% 　　　　for each thing in Request.Form 　　　　%> 　　　　 　　　　<% 　　　　next 　　　　%>

　　

　　

　　<%

　　Response.End

end sub

%>



















Listing 4.0 - discusslogo.asp

-------------------------------------------













　　

Microsoft Access Forum

Listing 5.0 - message.asp

------------------------------------



<%

id　　= TRIM( Request( "id" ) )

IF id = "-1" THEN id = ""



page = TRIM( Request( "pg" ) )

%>











<%

IF id = "" THEN

%>





　　

Select a message to read by clicking on one of the subjects above

<%

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

　　%>

　　

　　

　　　　

　　　　

　　

　　

　　　　

　　

　　

Author: <%=showUser( RS( "m_email" ) )%>	Date Posted: <%=RS( "m_entrydate" )%>
Subject: <%=Server.HTMLEncode( RS( "m_subject" ) )%>

　　

　　

　　　　

　　

　　

<%=formatOutput( RS( "m_message" ) )%> 　　　　 　　　　 　　　　Reply To This Message

　　<% if mcount = 0 THEN %>

　　

　　<% END IF %>

　　<%

RS.MoveNext

WEND

END IF

%>







----------------------------------------



























Listing 6.0 - messagelist.asp

-------------------------------------------

















　　

Post New Message

<%

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

　　%>

　　There are no messages

　　<%

ELSE

　　%>

　　

　　

　　　　

　　　　

　　　　

　　　　

　　

　　<%

　　WHILE NOT RS.EOF and counter < RS.PageSize

　　%>

　　

　　　　

　　　　

　　　　

　　　　

　　

　　<%

　　counter = counter+1

　　RS.MoveNext

　　WEND

　　%>

　　

AUTHOR	SUBJECT	REPLIES	DATE POSTED
<%=showUser( RS( "m_email" ) )%>	&pg=<%=page%>" target="message"> size="2"><%=Server.HTMLEncode( RS( "m_subject" ) )%>	<%=RS( "m_numreplies" )%> 　　　　<% IF cINT( RS( "m_numreplies" ) ) > 0 THEN %> 　　　　&pg=<%=page%>#replies" target="message">view 　　　　<% END IF %>	<%=RS( "m_entrydate" )%>

　　<%

　　IF RS.PageCount > 1 THEN

　　%>

　　

View Page:

　　<%

　　FOR i = 1 to RS.PageCount

　　IF i = cINT( page ) THEN

　　%>

　　<%=i%>

　　<%

　　ELSE

　　%>

　　<%=i%>

　　<%

　　END IF

　　NEXT

　　END IF

END IF

RS.Close

Con.Close

%>





----------------------------------------------















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" ) )

%>

<% IF id = "" THEN %>



<% ELSE %>



<% END IF %>











　　

　　





　　

　　





　　

　　





　　

Your Email Address:
Message Subject:
Message:	<%=Server.HTMLEncode( message )%<br><BR> >

相关阅读 Windows错误代码大全 Windows错误代码查询激活windows有什么用Mac QQ和Windows QQ聊天记录怎么合并 Mac QQ和Windows QQ聊天记录Windows 10自动更新怎么关闭 如何关闭Windows 10自动更新windows 10 rs4快速预览版17017下载错误问题Win10秋季创意者更新16291更新了什么 win10 16291更新内容windows10秋季创意者更新时间 windows10秋季创意者更新内容kb3150513补丁更新了什么 Windows 10补丁kb3150513是什么

文章评论

查看所有0条评论>>

发表评论

我来说两句...

提交评论