发信人: folmorse (◆金瓶楼主◆), 信区: VB
标 题: 一个BBS的简单例子
发信站: 大红花的国度 (Sun Jun 11 15:09:29 2000), 转信
发信人: bin (Nova 夜间飞行), 信区: ASP
标 题: [转载] [范文][ASP版]一个BBS的简单例子
发信站: 华南网木棉站 (Mon Dec 27 21:58:15 1999), 转信
【 以下文字转载自 New_board 讨论区 】
【 原文由 Mcu 所发表 】
add.asp
<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<title>回复信件</title>
</HEAD>
<BODY>
<% IF REQUEST("TYPE")="NEW" THEN
REPLYTITLE="" %>
<img SRC="PIC/NEW.JPG" ALT="开新信件" BORDER="1">
<% ELSE %>
<img SRC="PIC/REPLY.JPG" ALT="回复信件" BORDER="1">
<%REPLYTITLE=REQUEST("TITLE")
END IF%>
<%authorname = session("author") %>
<form METHOD="POST" action="add1.asp">
<p>
主题 :<input TYPE="TEXT" NAME="title" VALUE="<%=REPLYTITLE %>">
作者 : <input type="text" name="author" value=<% =authorname%>>
</p>
<p>
内容 :<textarea NAME="CONTEXT" COLS=110 ROWS=10></TEXTAREA></p>
<p>
<INPUT name=submit type=submit value=送出信件>
<a href="title.asp">返回</a>
</form>
</body>
</html>
add1.asp
<%dim title,context
title= Request.Form ("title")
context=Request.Form ("context")
author=Request.Form ("author")
if title="" then
title="No title"
end if
author=trim(author)
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\post.mdb;"
mysql ="SELECT * FROM BBS where id > 0 order by id"
Set rec = Server.CreateObject("ADODB.recordset")
rec.CursorType =3
rec.CursorLocation =3
rec.LockType =2
rec.Open mysql, mypath
rec.MoveLast
rEC.ADDNEW
REC("title")=title
REC("author")=author
rec("from")=session("id")
REC("subject")=context
REC("senddate")=DATE()
rec("sendtime")=time()
rec.Update
rec.Close
%>
<html>
<body>
<p>您的文章已经成功的发送到服务器上,请按"返回"返回.</p>
<P>
<a href="title.asp"
>返回</a> </P>
<P> </P>
</body>
</html>
EditInfo.asp
<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<title>注册判断</title>
</HEAD>
<BODY>
<% dim tusername,tpassword,mypath,mysql,StrSort,rs
tusername=Request.Form("username")
tdearname=Request.Form ("dearname")
tsex=Request.Form ("sex")
temail=Request.Form ("email")
taddress=Request.Form ("address")
tpassword=Request.Form("password")
tpassword1=Request.Form("password1")
tid=session("id")
tusername=replace(tusername,"'","''")
tdearname=replace(tdearname,"'","''")
tsex=replace(tsex,"'","''")
tid=replace(tid,"'","''")
temail=replace(temail,"'","''")
taddress=replace(taddress,"'","''")
tpassword=replace(tpassword,"'","''")
tpassword1=replace(tpassword1,"'","''")
if tdearname="" then
tdearname=tusername
end if
flag=false
if tusername="" then
flag=true
end if
if tpassword="" or tpassword1="" then
flag=true
end if
if flag=true then %>
<p>对不起,您没能填写完整的个人信息,请返回并重新填写用户信息.</p>
<a href="EditInfo.htm">返回</a>
<%
else
if tpassword=tpassword1 then
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\user.mdb;"
mysql ="SELECT * FROM UserInfo WHERE iD = '"& tid & "'"
Set rs = Server.CreateObject("ADODB.recordset")
rs.CursorType =3
rs.CursorLocation =3
rs.LockType =2
rs.Open mysql, mypath
if tusername<>"" then
rs("name")=tusername
end if
if tpassword<>"" then
rs("password")=tpassword
end if
rs("email")=temail
rs("address")=taddress
if tdearname="" then
tdearname=tusername
end if
rs("dearname")=tdearname
rs("sex")=tsex
rs.Update
rs.Close
%><p>祝贺您,用户信息修改成功.</p>
<a href="title.asp">返回</a>
<% else %>
<p>对不起,您两次输入的密码不相同,请返回并重新填写用户信息.</p>
<a href="EditInfo.htm">返回</a>
<%end if
end if%></BODY>
</HTML>
Enter.asp
<%@ Language=VBScript %>
<% dim tusername,tpassword,mypath,mysql,StrSort,rs
tusername=Request.Form("username")
tpassword=Request.Form("password")
tusername=replace(tusername,"'","''")
tpassword=replace(tpassword,"'","''")
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\user.mdb;"
mysql ="SELECT * FROM UserInfo WHERE ID = '"& tusername &"' and Password
= '" & tpassword &"'"
Set rs = Server.CreateObject("ADODB.recordset")
rs.CursorType =3
rs.CursorLocation =3
rs.LockType =3
rs.Open mysql, mypath
if rs.BOF then %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<title>注册判断</title>
</HEAD>
<BODY>
<p>您输入的帐号/密码不正确,请返回并重新填写.</p>
<a href="bbs.htm">返回</a>
</BODY>
</HTML>
<%else
session("id")=tusername
session("include")="ten"
session("author")=rs("dearname")
Response.Redirect "title.asp"
rs.Close
end if
%>
Regist.asp
<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<title>注册判断</title>
</HEAD>
<BODY>
<% dim tusername,tpassword,mypath,mysql,StrSort,rs
tusername=Request.Form("username")
tdearname=Request.Form ("dearname")
tsex=Request.Form ("sex")
temail=Request.Form ("email")
tid=Request.Form ("id")
taddress=Request.Form ("address")
tpassword=Request.Form("password")
tpassword1=Request.Form("password1")
tusername=replace(tusername,"'","''")
tdearname=replace(tdearname,"'","''")
tsex=replace(tsex,"'","''")
temail=replace(temail,"'","''")
tid=replace(tid,"'","''")
taddress=replace(taddress,"'","''")
tpassword=replace(tpassword,"'","''")
tpassword1=replace(tpassword1,"'","''")
if tdearname="" then
tdearname=tusername
end if
flag=false
if tusername="" or tid="" then
flag=true
end if
if tpassword="" or tpassword1="" then
flag=true
end if
if flag=true then %>
<p>对不起,您没能填写完整的个人信息,请返回并重新填写用户注册信息.</p>
<a href="newuser.htm">返回</a>
<%
else
if tpassword=tpassword1 then
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\user.mdb;"
mysql ="SELECT * FROM UserInfo WHERE iD = '"& tusername & "'"
Set rs = Server.CreateObject("ADODB.recordset")
rs.CursorType =3
rs.CursorLocation =3
rs.LockType =2
rs.Open mysql, mypath
if rs.BOF then
rs.AddNew
rs("name")=tusername
rs("id")=tid
rs("password")=tpassword
rs("email")=temail
rs("address")=taddress
rs("dearname")=tdearname
rs("sex")=tsex
rs.Update
rs.Close
%><p>祝贺您,用户新帐号注册成功,返回主界面后就可进入BBS了.</p>
<a href="bbs.htm">返回</a>
<%else
rs.close
%>
<p>用户帐号已存在,请返回并以另一帐号重新注册.</p>
<a href="newuser.htm">返回</a>
<%end if
else
rs.close
%>
<p>对不起,您两次输入的密码不相同,请返回并重新填写用户注册信息.</p>
<a href="newuser.htm">返回</a>
<%end if
end if%>
Show.asp
<%
dim mypath,k,mysql,StrSort,rs
IF REQUEST("KEY")="" THEN
K=1
ELSE
K=REQUEST("KEY")
END IF
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\post.mdb;"
mysql ="SELECT * FROM BBS WHERE ID = " & k
Set rs = Server.CreateObject("ADODB.recordset")
rs.CursorType =3
rs.CursorLocation =3
rs.LockType =3
rs.Open mysql, mypath
%>
<html>
<head>
<title>阅读文章</title>
</head>
<body BGCOLOR="FFFFFF">
<div align="left">
<center>
<table BORDER="1">
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">来自:</td>
<td BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("from") %> </td>
</tr>
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">主题:</td>
<td WIDTH="400" BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("titl
e") %> </td>
</tr>
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">作者:</td>
<td BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("author") %></td>
</tr>
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">内容:</td>
<td WIDTH="400" BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("subj
ect") %></td>
</tr>
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">发送日期:</td>
<td BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("senddate") %></t
d>
</tr>
<tr>
<td BGCOLOR="DDDDFF" ALIGN="LEFT">发送时间:</td>
<td BGCOLOR="FFDDDD" ALIGN="LEFT"><% RESPONSE.WRITE RS("sendtime") %></t
d>
</tr>
</table>
<tr>
<a HREF="ADD.ASP?TYPE=REPLY&TITLE=<% = "Re:"&rs("title") %>">
回复信件</a>
<a HREF="ADD.ASP?TYPE=NEW">
开新信件</a>
<a href="title.asp">
返回</a>
</tr>
</center>
</div>
</body>
</html>
Title.asp
<% @ LANGUAGE="VBSCRIPT" %>
<html>
<head>
<title></title>
</head>
<body bgcolor="ffffdd">
<%
dim mypath,dbConnection,rst,mysql
SET dbConnection = server.createobject("ADODB.Connection")
mypath="Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("\
bbs") & "\post.mdb;"
dbConnection.Open mypath
call setVariables
Set rst = Server.CreateObject("ADODB.recordset")
rst.CursorType =3
rst.CursorLocation =3
rst.LockType =3
rst.Open mysql, mypath
%>
<p>ACTIVE SERVER PAGES 讨论区 </p>
<p>
<a HREF="ADD.ASP?TYPE=NEW&Author=<%=request("author")%>&from=<%=request("fr
om")%>">
开新信件</a>
<a href="bbs.htm">返回</a>
<a href="EditInfo.htm">修改个人信息</a>
<p>
<% newurl="title.asp?include=ten"%>
<a href="<%=newurl%>">前10篇</a>
<% newurl="title.asp?include=fifty"%>
<a href="<%=newurl%>">前50篇</a>
<% newurl="title.asp?include=hundge"%>
<a href="<%=newurl%>">前100篇</a>
<% newurl="title.asp?include=all"%>
<a href="<%=newurl%>">所有文章</a>
</p>
</p>
<table BORDER="1" BGCOLOR="FFDDDD">
<tr>
<td WIDTH="200" BGCOLOR="DDDDFF">主题</td>
<td WIDTH="50" BGCOLOR="DDDDFF">作者</td>
<td WIDTH="100" BGCOLOR="DDDDFF">传送日期</td>
<td Width="100" bgcolor="ddddff">传送时间</td>
</tr>
<% if request("include")<>"" then
session("include")=request("include")
end if
if session("include")="ten" then
num=10
end if
if session("include")="fifty" then
num=50
end if
if session("include")="hundge" then
num=100
end if
if session("include")="all" then
num=rst.RecordCount
end if
rst.MoveFirst
n=1
DO WHILE NOT rst.EOF %>
</tr>
<tr>
<td><a HREF="SHOW.ASP?KEY=<% = rst("ID") %>&author=<%=Request("author")%
>&from=<%=request("from")%>"><% = rst("title")%></a></td>
<td><% = rst("AUTHOR")%>
</td>
<td><% = rst("SENDDATE")%>
</td>
<td><% = rst ("sendtime")%>
</td>
</tr>
<%
rst.MoveNext
n=n+1
if n>num then
rst.MoveLast
rst.MoveNext
end if
LOOP
Sub setVariables
strQuery ="SELECT * FROM BBS WHERE ID <> 0"
StrSort = "id Desc"
strQuery= strquery & " ORDER BY " & StrSort
mysql = strQuery
End Sub
%>
</table>
</body>
</html>
--
^-^
我始终相信自己的明天更美好，所以我一直在很努力的追求着那个梦想。
相信朋友，相信自己，相信机会面前人人平等。
付出终有回报！
※ 修改:．folmorse 于 Jun 11 15:08:41 修改本文．[FROM: hpwei.hit.edu.cn]
※ 来源:．华南网木棉站 bbs.gznet.edu.cn．[FROM: 202.38.250.115]
--
※ 转载:．华南网木棉站 bbs.gznet.edu.cn．[FROM: 202.38.248.167]
--
※ 转寄:．华南网木棉站 bbs.gznet.edu.cn．[FROM: hpwei.hit.edu.cn]
--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: folmorse.bbs@melon.g]