前些日子整理的代码
<%@ LANGUAGE = VBScript CodePage = 936%>
<%
'程序出处 :VA GuestBook System By Vanery
'版 本 :Version 1.16单用户精简版 (新版本研究中)
'QQ :296338925
'Email :vanery@126.com
'声 明 :本程序仅供ASP编程爱好者参考学习,所有代码均开源提供。
'发布日期 :2007年9月19日
'作 者 :阿威
'官网地址 :jaker.137.tofor.com
'初始帐号 :admin 密码:123465
'
'-----------------------------------------------------------------------------------连接数据库
Dim Conn,Connstr,uip,SiteName,wtime,StartTime
StartTime = Timer()
SiteName="VA GuestBook System" '-------------------留言本名字
wtime=now()
Set Conn=Server.CreateObject("ADODB.Connection")
DB="Images/#data.mdb"
Connstr="DBQ="+server.mappath(DB)+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)}"
on error resume next
Conn.open Connstr
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "数据库连接出错,请检查连接字串。"
Response.End
End If
'--------------------------------------------------------------------------------------获取IP
uip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If uip = "" Then uip = Request.ServerVariables("REMOTE_ADDR")
'-----------------------------------------------------------------------------------定义文字内容规范
Function MyReplace(sMsg)
sMsg = Trim(sMsg)
sMsg = Replace(sMsg, "<", "<")
sMsg = Replace(sMsg, ">", ">")
sMsg = Replace(sMsg, Chr(13) & Chr(10), "<br>") '回车换行
sMsg = Replace(sMsg, Chr(32), " ") '空格
sMsg = Replace(sMsg, Chr(34), """) ' " 双引号
sMsg = Replace(sMsg, Chr(9), " ") 'Tab
MyReplace = sMsg
End Function
'------------------------------------------------------------------------------------------
%>
<html><head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="Keywords" content=<%=SiteName%> />
<meta name="Description" content=<%=SiteName%> />
<title><%=SiteName%></title>
<SCRIPT LANGUAGE="JavaScript">
<!--
function checkform()
{
var title = document.addmsg.title.value;
if (title=="") {
alert("请输入留言标题!");
addmsg.title.focus();
return (false);}
var nam = document.addmsg.nam.value;
if (nam=="") {
alert("请输入您的姓名!");
addmsg.nam.focus();
return (false);}
var msg = document.addmsg.msg.value;
if (msg=="" | msg.length <3 | msg.length >500) {
alert("留言内容长度不对!请控制在3-500字之间!");
addmsg.msg.focus();
return (false);}
return true;
}
// -->
</SCRIPT>
<style type="text/css">
<!--
A {COLOR: #000000; TEXT-DECORATION: none}
A:hover {COLOR: #FF3300}
SELECT {BORDER-RIGHT: #ffffff 1px solid; BORDER-TOP: #cccccc 1px solid; FONT-SIZE: 8pt; BORDER-LEFT: #cccccc 1px solid; BORDER-BOTTOM: #cccccc 1px solid; FONT-FAMILY: "Verdana"}
INPUT {BORDER-RIGHT: #cccccc 1px solid; BORDER-TOP: #cccccc 1px solid; FONT-SIZE: 8pt; BORDER-LEFT: #cccccc 1px solid; BORDER-BOTTOM: #cccccc 1px solid; FONT-FAMILY: "verdana"}
TEXTAREA {BORDER-RIGHT: #cccccc 1px solid; BORDER-TOP: #cccccc 1px solid; FONT-SIZE: 8pt; BORDER-LEFT: #cccccc 1px solid; LINE-HEIGHT: 16px; BORDER-BOTTOM: #cccccc 1px solid; FONT-FAMILY: "Verdana"}
TD {FONT-SIZE: 8pt; LINE-HEIGHT: 150%; FONT-FAMILY: "Verdana", "Arial", "Helvetica", "sans-serif"}
P {LINE-HEIGHT: 20px}
body {
SCROLLBAR-3DLIGHT-COLOR: #bebebe;
SCROLLBAR-ARROW-COLOR: #0099ff;
SCROLLBAR-DARKSHADOW-COLOR: #bebebe;
SCROLLBAR-BASE-COLOR: #f2f2f2;
}
.Top{
font-family: Arial, Helvetica, sans-serif;
font-size: 16px;
font-weight: bold;
color: #0066CC;
}
.Title{
font-family: Arial, Helvetica, sans-serif;
font-size: 12px;
font-weight: bold;
color: #ff9900;
}
.Copyright {
font-family: Arial, Helvetica, sans-serif;
font-size: 12px;
color: #666666;
}
-->
</style>
</head>
<body topmargin="0">
<table width="700" height="400" border="0" align="center" cellpadding="0" cellspacing="1" bgcolor="#bebebe">
<tr>
<td height="32" bgcolor="#F9F9F9"> <b><font class="Top"><%=SiteName%></font></b> <a href=GuestBook.asp>首 页</a>|<%If Session("admin")="" then%><a href="?Action=Login">管理员登陆</a><%Else%> <a href="?Action=LoginOut">注销登陆</a>|<a href="?Action=rePassword">修改密码</a>|当前操作员:<font color="#FF3300"><%=Session("admin")%></font><%End If%></td>
</tr>
<tr>
<td height="1" bgcolor="#ffffff">
</td>
</tr>
<tr>
<td align="center" valign="top" bgcolor="#FFFFFF">
<br>
<%
Dim Action,Admin
Set Rs = Server.CreateObject("ADODB.Recordset")
Action = Request.QueryString("Action")
Admin = "$Admin001"
Select Case Action
Case "Add" '-------------------------------------------------添加留言
title=MyReplace(request.Form("title"))
if session("admin")="" Then
nam=Replace(request.Form("nam"),Chr(32),"")
if nam="管理员" then nam="猪头三"
if nam="admin" then nam="猪头三"
nam=MyReplace(request.Form("nam"))
else
nam="admin"
msg = Replace(request.Form("msg"), Chr(13) & Chr(10), "<br>")
end if
msg=MyReplace(request.Form("msg"))
sex=request.Form("sex")
email=MyReplace(request.Form("email"))
conn.execute "insert into Content (Title,Wname,Wsex,Msg,Wtime,WIP) values ('"&title&"','"&nam&"','"&sex&"','"&msg&"','"&Wtime&"','"&uip&"')"
set title=nothing
set nam=nothing
set sex=nothing
set msg=nothing
set email=nothing
response.write "<script language=JavaScript>" & chr(13) & "alert('留言成功!')</script>"
response.redirect "GuestBook.asp"
Case "Delete" '-----------------------------------------------删除留言
if request("id")<>empty then
if session("admin")="" then
response.redirect ("login.asp")
end if
conn.Execute("delete * from Content where gid="&trim(request("id")))
end if
response.redirect "GuestBook.asp"
Case "Seta" '-----------------------------------------------置顶留言
if request("id")<>"" then
if session("admin")="" then
response.redirect ("login.asp")
end if
conn.Execute("update Content set Sets=1 where gid="&trim(request("id")))
end if
response.redirect "GuestBook.asp"
Case "Setat" '-----------------------------------------------解除置顶留言
if request("id")<>"" then
if session("admin")="" then
response.redirect ("login.asp")
end if
conn.Execute("update Content set Sets=0 where gid="&trim(request("id")))
end if
response.redirect "GuestBook.asp"
Case "Revert" '------------------------------------------------显示回复表单
if session("admin")="" then
response.redirect ("login.asp")
end if
Sql = "Select * From Content Where GID="&trim(request("id"))
rs.open sql,conn,1,1
%>
<form action="?Action=SaveRevert&id=<%=trim(rs("gid"))%>" name="huifu" method="post">
<div align=center>回复<%=rs("wname")%>的留言</div>
<div align=center><textarea name="gmhuifu" cols=60 rows=6 id="gmhuifu"><%=MyReplace(rs("RConten"))%>
</textarea></div>
<div align=center><input name=Submit type=submit value=回复> <a href=GuestBook.asp> 返回</a></div></form><script language="javascript">
var i = 10;
function counter() {
if (i >= 0) {
var obj = document.getElementById("counter");
obj.innerText = i;
i = i - 1;
setTimeout(counter, 1000);
}
else {
location.href = "GuestBook.asp";
}
}
window.onload = counter;
</script>
<%
set sql=nothing
set Rs=nothing
response.Write("</td></tr></table>")
Case "EditRevert" '------------------------------------------------编辑留言
if session("admin")="" then
response.redirect ("login.asp")
end if
Sql = "Select * From Content Where GID="&trim(request("id"))
rs.open sql,conn,1,1
%>
<form action="?Action=SaveEdit&id=<%=trim(rs("gid"))%>" name="huifu" method="post">
<div align=center>编辑 <font corlor=red>管理员</font> <%=Rs("Wtime")%> 发布的留言信息</div>
<div align=center><textarea name="gmhuifu" cols=90 rows=16 id="gmhuifu"><%=rs("msg")%></textarea></div>
<div align=center><input name=Submit type=submit value=确定> <a href=GuestBook.asp> 返回</a></div></form></td></tr></table>
<%
Case "SaveEdit" '------------------------------------------------保存编辑
if request("id")<>empty then
if session("admin")="" then
response.redirect ("login.asp")
end if
conn.Execute("update Content set msg='"&(request.Form("gmhuifu"))&"' where gid="&trim(request("id")))
end if
response.redirect "GuestBook.asp"
Case "SaveRevert" '------------------------------------------------保存回复
if request("id")<>empty then
if session("admin")="" then
response.redirect ("login.asp")
end if
conn.Execute("update Content set RConten='"&MyReplace(request.Form("gmhuifu"))&"' where gid="&trim(request("id")))
end if
response.redirect "GuestBook.asp"
Case "Login" '------------------------------------------------登进
If Session("Admin")="" then
If Request.ServerVariables("Request_Method")="GET" then
response.write("<form name=formLogin method=post action=""?Action=Login"">")
response.write("<table width=200 border=0 align=center cellpadding=0 cellspacing=4><tr><td heigth=24>用户名:</td> ")
response.write("<td><input type=text name=""UserName"" size=12></td></tr>")
response.write("<tr><td height=24>管理密码: </td>")
response.write("<td><input type=password name=""Password"" size=12></td></tr>")
response.write("<tr><td align=right><input type=submit name=Submit value=提交></td><td align=center><input type=reset name=Submit value=重置></td></tr>")
response.write("</table>")
response.write("</form>")
response.Write("</td></tr></table>")
else
Dim Username,Password
Username=request.form("UserName")
Password=request.form("Password")
sql="SELECT * FROM admin where username='"&Username&"' and upassword='"&Password&"'"
rs.open sql,conn,1,1
if rs.eof or rs.bof then
response.write "<script language=JavaScript>" & chr(13) & "alert('帐号或密码错误,请核实!');" & "history.back()" & "</script>"
response.end
else
session("admin")=Username
set sql=nothing
set Password=nothing
set Username=nothing
response.redirect "?"
end if
end if
Else
response.Write("已登陆用户!<span id=""counter""></span> 秒后返回")
End if
Case "LoginOut" '-----------------------------------------------------------登出
Session("Admin") = ""
Response.Redirect("?")
Case "rePassword" '-----------------------------------------------------------修改密码
If Session("Admin")<>Empty then
response.Write("<form name=rePassword method=post action=""?Action=SavePassword"">新密码: <input type=password name=rePassword id=rePassword size=12 />")
response.Write(" <input type=submit name=Submit Value=确定 /></form>")
response.Write("</td></tr></table>")
Else
Response.Redirect("GuestBook.asp")
End If
Case "SavePassword" '----------------------------------------------------------保存修改密码
If Session("Admin")="" then
Response.Redirect("GuestBook.asp")
response.End()
End If
saPassword=MyReplace(request.Form("rePassword"))
conn.Execute("update Admin set upassword='"&saPassword&"' where UID=1")
response.Write ("<script language=JavaScript>" & chr(13) & "alert('修 改 成 功 !请 重 新 登 陆!');" & "location.href =""?Action=LoginOut"";" & "</script>")
Case Else '----------------------------------------------------------正式显示
Sql = "Select * From Content Order BY Sets desc , Gid Desc"
Rs.Open Sql,conn,1,1
IF Rs.Eof or rs.bof Then
Response.Write "<br><br><p><p><FONT STYLE=font-size:9pt>目前还没有任何信息</FONT>"
else
totalrecord=rs.recordcount
IF Request("s")="" Then
ShowNum=10
Else
ShowNum=Request("s")
End IF
rs.pagesize=ShowNum
maxpage=rs.pagecount
requestpage=clng(request("p"))
if requestpage="" or requestpage=0 then
requestpage=1
end if
if resquestpage>maxpage then
resquestpage=maxpage
end if
if not requestpage=1 then
rs.move (requestpage-1)*rs.pagesize
end if
for i=1 to rs.pagesize and not rs.bof
%>
<table width="98%" border="0" cellpadding="0" cellspacing="1" bgcolor="#bebebe">
<tr valign="top">
<td width="100" bgcolor="#FFFFFF" align="center"><br><% If Rs("wname")="admin" then %><font color=red>管理员</font><%else%><%=Rs("wname")%><%end if%><br><br>
<img src="Images/<%=rs("wsex")%>.jpg" border="0"></td>
<td><table width="100%" height="100" border="0" cellpadding="0" cellspacing="0">
<tr>
<td height="25" bgcolor="f0f0f0"><table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="24">
<b>
<%If Rs("Sets")=1 then
response.Write("<font color=red >『置顶』</font> ")
End If%><font color="#333333"><%=Rs("title")%></font></b> </td>
<td width='200' height='24' align="right">
<%if session("admin")<>"" then
If Rs("Sets")=1 then
%>
<a href="?Action=Setat&id=<%=rs("gid")%>" title=解除置顶>解顶</a>
<%else%>
<a href="?Action=Seta&id=<%=rs("gid")%>" title=置顶此条信息>置顶</a><%end if%>
<%if Rs("Wname")="admin" then
%>
<a href="?Action=EditRevert&id=<%=rs("gid")%>" title=编辑此条信息>编辑</a>
<%end if%>
<a href="?Action=Revert&id=<%=rs("gid")%>" title=回复此条信息>回复</a>
<a href="?Action=Delete&id=<%=rs("gid")%>" title=删除此条信息>删除</a>
<%end if%></td>
<td width="130" align="right"><%=trim(rs("wtime"))%> </td>
</tr>
</table></td>
</tr>
<tr>
<td bgcolor="#FFFFFF"><table width="90%" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td><%=rs("msg")%></td>
</tr>
</table>
<br><div class="Copyright">
<%If trim(rs("rconten"))<>"" then
response.write ("管理员回复:"&rs("rconten"))
Else
response.write ("")
End If
%></div></td>
</tr>
</table></td>
</tr>
</table>
<br>
<% Rs.MoveNext
if rs.eof then exit for
next
End If
set sql=nothing
%>
<tr>
<td valign="top" height="20"> 共 <%=maxpage%> 页 分页: [
<%
For i=1 to maxpage
Response.Write "<a href=GuestBook.asp?p="&i&"&s="&ShowNum&">"&i&"</a> "
Next
%>
]</td>
</tr>
</table>
<%
response.Write("<br><table width=450 border=0 align=center cellpadding=4 cellspacing=1 bgcolor=#f2f2f2><form name=addmsg method=post action=""?Action=Add"" onSubmit=""return checkform()"">")
response.Write(" <tr> <td width=60 align=right bgcolor=#FFFFFF>标 题:</td><td bgcolor=#FFFFFF><input name=title type=text size=30 maxlength=20></td></tr>")
response.Write("<tr><td align=right bgcolor=#FFFFFF>姓 名:</td><td bgcolor=#FFFFFF><input name=nam type=text value=匿名 size=30 maxlength=6></td></tr>")
response.Write("<tr><td align=right bgcolor=#FFFFFF>性 别: </td><td bgcolor=#FFFFFF><INPUT type=radio name=sex value=boy CHECKED>男 <INPUT type=radio name=sex value=girl /> 女</td></tr>")
response.Write("<tr><td align=right bgcolor=#FFFFFF>内 容: </td><td bgcolor=#FFFFFF><textarea name=msg cols=60 rows=10 id=msg></textarea></td></tr><tr align=center><td colspan=2 bgcolor=#FFFFFF><input type=submit name=Submit id=Submit value=提交 class=submit> <input type=reset name=Submit2 value=重写 class=reset></td></tr></form></table>")
End Select
Set Conn=Nothing
Set Connstr=Nothing
Set uip=Nothing
Set SiteName=Nothing
Set wtime=Nothing
Response.Write (" <div align=center class=copyright><br>CopyRight 2006-2007 Power By <a href=http://my.51job.com/sc/applyjob/preview_resume.php?ID=6686192&RSMID=6686192>VA GuestBook System</a></div>")
Response.Write ("<div align=center class=copyright>QQ:405991450 E-Mail:<a href=mailto:vanery@126.com>vanery@126.com</a></div>")
Response.Write ("<div align=center class=copyright>页面执行时间:"&(Timer() - StartTime) * 1000 & "毫秒</div><br></body></html>")
Set StartTime=Nothing
response.End()
%>