《2yup漂流祈愿瓶大家一齐做》（四）
'***************************************************************
以下是全部的副程式部分：
[说明]副程式调用是以参数Action为依据，这在第二讲中已经很清楚地表达出来了。
请将他们依照第一讲的位置各就各位放好，让页面必要时候调用。按固定的位置放好，以后只要拿出规划图就知道在那个位置，维护起来就容易了。
<%
'**************************
'***** 副程式部分 *****
'**************************
%>
<%
''================祈愿输入和修改界面1================
Sub Wish()
'如果是修改就读出原数据，并将Action设定成SaveEdit(保存修改)
'否则，将Action设定成Save(保存新数据)
if UserName <> "" and Action = "EditWish" and id <> "" then
name = Rs("name")
Sex = Rs("Sex")
mail = Rs("mail")
purpose = Rs("purpose")
live = Rs("live")
Content = Rs("Content")
My_Age = MyAge(Rs("Birthday"))
Action = "SaveEdit"
else
Action = "Save"
end if
%>
<div align="center">
<center>
<table border="0" cellpadding="0" cellspacing="1">
<tr><FORM method='post' action='<%=Request.ServerVariables("URL")%>'>
<INPUT TYPE="hidden" NAME="Action" VALUE="<%=Action%>">
<INPUT TYPE="hidden" NAME="id" VALUE="<%=id%>">
<td align="right">名字：</td>
<td><input type="text" size="12" maxlength="12" name="name"
VALUE="<%=name%>" onclick="
javascript:this.value='';"> </td>
<td align="right">性别：</td>
<td><select name="sex" size="1">
<%If Sex <> "" Then%>
<option value="<%=Sex%>" Selected><%=Sex%></option>
<%End If%>
<option value="">-请选择-</option>
<option value="先生">男 生</option>
<option value="小姐">女 生</option>
</select></td>
</tr>
<tr>
<td align="right">信箱：</td>
<td><input type="text" size="12" name="mail" VALUE="<%=mail%>"
onclick="
javascript:this.value='';"></td>
<td align="right">目的：</td>
<td><select name="purpose" size="1">
<%'转换英文名称为中文
If purpose <> "" Then
Select Case purpose
Case "family"
Chinese_purpose = "家庭"
Case "friend"
Chinese_purpose = "朋友"
Case "future"
Chinese_purpose = "将来"
Case "health"
Chinese_purpose = "健康"
Case "life"
Chinese_purpose = "生活"
Case "love"
Chinese_purpose = "恋爱"
Case "study"
Chinese_purpose = "学业"
Case "wealth"
Chinese_purpose = "财富"
Case "work"
Chinese_purpose = "事业"
End Select%>
<option value="<%=purpose%>" Selected><%=Chinese_purpose%></option>
<%End If%>
<option value="">-请选择-</option>
<option value="love">恋 爱</option>
<option value="study">学 业</option>
<option value="health">健 康</option>
<option value="family">家 庭</option>
<option value="work">事 业</option>
<option value="future">将 来</option>
<option value="wealth">财 富</option>
<option value="life">生 活</option>
<option value="friend">朋 友</option>
</select></td>
</tr>
<tr>
<td align="right">年龄：</td>
<td><input type="text" size="12" name="Age" VALUE="<%=My_Age%>"
onclick="
javascript:this.value='';"></td>
<td align="right">地区：</td>
<td><select name="live">
<%If live <> "" Then%>
<option value="<%=live%>" Selected><%=live%></option>
<%End If%>
<option value="">-请选择-</option>
<option value="北京">北京</option>
<option value="上海">上海</option>
<option value="天津">天津</option>
<option value="重庆">重庆</option>
<option value="河北">河北</option>
<option value="山西">山西</option>
<option value="内蒙古">内蒙古</option>
<option value="辽宁">辽宁</option>
<option value="吉林">吉林</option>
<option value="黑龙江">黑龙江</option>
<option value="江苏">江苏</option>
<option value="浙江">浙江</option>
<option value="安徽">安徽</option>
<option value="福建">福建</option>
<option value="江西">江西</option>
<option value="山东">山东</option>
<option value="河南">河南</option>
<option value="湖北">湖北</option>
<option value="湖南">湖南</option>
<option value="广东">广东</option>
<option value="广西">广西</option>
<option value="海南">海南</option>
<option value="四川">四川</option>
<option value="贵州">贵州</option>
<option value="云南">云南</option>
<option value="西藏">西藏</option>
<option value="陕西">陕西</option>
<option value="甘肃">甘肃</option>
<option value="宁夏">宁夏</option>
<option value="青海">青海</option>
<option value="新疆">新疆</option>
<option value="香港">香港</option>
<option value="澳门">澳门</option>
<option value="台湾">台湾</option>
<option value="其它">其它</option>
</select></td>
</tr>
<tr>
<td colspan="4">
<textarea name="Content" rows="4" cols="41"><%=Content%></textarea>
<p ALIGN="center">
<input type="submit" value="许下一个心愿" CLASS="Submit"></td></tr>
</form>
</center>
</div>
<%End Sub%>
<%''================保存祈愿副程序2================
Sub SaveWish()
'获取
name = request("name")
sex = request("sex")
purpose = request("purpose")
mail = request("mail")
live = request("live")
Content = request("Content")
Age = request("Age")
'验证
if name = "" then Notice = "\n\n 名字不能为空。"
if sex = "" then Notice = Notice &"\n\n 性别不能为空。"
if mail = "" then Notice = Notice &"\n\n 信箱不能为空。"
if Content = "" then Notice = Notice &"\n\n 内容不能为空。"
if live = "" then Notice = Notice &"\n\n 必须选择地区。"
if purpose = "" then Notice = Notice &"\n\n 必须选择目的。"
if Age = "" then Notice = Notice &"\n\n 年龄不能为空。"
if isNumeric(birthday) = False then Notice = Notice &" 年龄应是数字。"
'内容不完整提示
If Notice <> "" Then
ToUrl = "history.go(-1)"
Else
'内容完整入库
if Action = "SaveEdit" then
findData = "where id like '"&id&"'"
Notice = "许愿瓶已经成功修改了编号为 "&id&" 的祈愿瓶。"
ToUrl = "history.go(-2)"
end if
sql = "select * from wish "&findData&""
Call changetable(conn,sql,rs,3)
if Action = "Save" then
Notice = "许愿瓶已经成功投放，祝您好运！"
ToUrl = "window.location='index.asp'"
rs.addnew
end if
rs("name") = name
rs("sex") = sex
rs("purpose") = purpose
rs("mail") = mail
rs("live") = live
rs("Content") = Content
rs("birthday")= Mybday(Age)
rs.update
End If
'调用提示通用函数显示提示内容
Call prompt(Notice,ToUrl)
End Sub
%>
<%
'================显示祈愿副程序3================
Sub ViewWish()
'如果已经登入就显示管理序号、删除和修改按钮。
'登入时Action="EditWish" 准备点击后调用Wish()修改用。
'未登入时Action="detail"这样调用Wish()时只产生查看效果。
if UserName <> "" then
Action = "EditWish"
else
Action = "detail"
end if
if Not Rs.bof or Not Rs.eof then
Rs.MoveFirst
Rs.move(max*(Cpage-1))
end if
i = 1
do while not rs.eof
'乱码制造不同的速度
Randomize
z = Fix(Rnd*(i+4))+1
'在搜索和登入时候会同速放慢漂流
if keyword <> "" or UserName <> "" then
z = rate
end if
'鼠标暂停特效
thisStop = " onMouseOut='this.start()' onMouseOver='this.stop()'"
'显示流动内容
Response.Write "<BR><marquee scrollamount="&z&" "&thisStop&">"
if UserName <> "" then '验证是否登入
'显示删除击点(登入后才有)
Response.Write "<A HREF='?Action=del&id="&rs("id")&"&page" _
&"="&Cpage&"' TITLE='点击删除'>"
Response.Write "No:"&rs("id")&" X</A>"
end if
'点击查看或修改
Response.Write "<a href='?id="&rs("id")&"&Action="&Action&"'" _
&"ONMOUSEOVER=""pop('" _
&"今年" &MyAge(Rs("birthday"))& "岁" _
&"住在" &rs("Live")& "的" _
&""&rs("Name")&rs("Sex")&"" _
&"在这里许了个愿...<BR>" _
&"有" & rs("Hit") &"个人看过<BR>" _
&"(点击查看)','#ececec')""; ONMOUSEOUT='kill()'>" _
&"<img border='0' src='"&picPath&rs("Purpose")&imgType&"'></a>"
Response.Write "</marquee>"
if i>=max then exit do
i=i+1
rs.movenext
loop
End Sub
%>
<%
''================查看详情副程序4================
Sub ViewDetail()
'非管理员查看时点击数+1
if UserName = "" then
Rs("hit") = Rs("hit")+1
Rs.Update
end if
'显示祈愿内容(祈愿详情)
Response.Write "<CENTER>" _
&"<table border=0 cellpadding=0 cellspacing=0 width=95% height=42>" _
&"<tr>" _
&"<td width=21% height=42>" _
&"<p align=center><img src='"&picPath&""&rs("purpose")&imgType&"'" _
&" align=absmiddle></td>" _
&"<td width=79% height=42>" _
& MyAge(rs("birthday")) &"岁来自"&Rs("live")&"的 " _
& "<a href='mailto:"&Rs("mail")&"'>"&Rs("name")&"</a> "&rs("Sex")&"，" _
& "于"&Rs("date")&"留下此愿：<BR><BR>"&rs("Content")&"<BR><BR>" _
&"之前共有 "&Rs("hit")-1&" 人看过此愿。<BR><BR>" _
&"<A href='index.asp'>[BACK]</A></td>" _
&"</tr>" _
&"</CENTER>" _
End Sub
%>
<%
''================翻页设定副程序5================
Sub PageSet()
''--------------Set--------------
IF NOT rs.EOF THEN
'设定总页数
numpage=num\max+1
if num mod max=0 then
numpage=num\max
end if
'设定当前页码
if Cpage = "" then
Cpage = 1
else
Cpage = cInt(Cpage)
end if
END IF
'使numpage在空值的情况下显示成0
if numpage = "" then numpage = 0 end if
''--------------Show-------------
'显示
Response.Write "<select name='SLIGHTBOY'" _
&"onChange='location.href=this.options[this.selectedIndex].value;'>"
Response.Write "<option value='index.asp?page="&Cpage&"&k" _
&"="&keyword&"&H="&howfind&"'>PAGE"&Cpage&"</option>"
For i = 1 to numpage
Response.Write "<option value='index.asp?page="&i&"&k" _
&"="&keyword&"&H="&howfind&"'>PAGE"&i&"</option>"
Next
Response.Write "</select>"
Response.Write " 共 <font color='#808080'><b>"&num&"</b></font> 瓶 | " _
&"分 <font color='#808080'><b>"&numpage&"</b></font> 页 | " _
&"<font color='#808080'><b>"&max&"</b></font>瓶/页"
End Sub
%>
<%
''================祈愿搜索副程序6================
Sub SearchEngine()
Response.Write "<FORM method='post' action='"&Request.ServerVariables("URL")&"'>" _
&"<input type='hidden' name='Action' VALUE='Search'>" _
&"<input class='input2' type='text' size='8' name='K' VALUE='"&Keyword&"'> " _
&"<SELECT NAME='H'>" _
&"<OPTION VALUE='name'>名字</OPTION>" _
&"<OPTION VALUE='sex'>性别</OPTION>" _
&"<OPTION VALUE='mail'>电邮</OPTION>" _
&"<OPTION VALUE='live'>省份</OPTION>" _
&"<OPTION VALUE='Content'>内容</OPTION>" _
&"</SELECT> " _
&"<INPUT class='Submit' type='submit' value='搜索'>"
End Sub
%>
<%
''================最后祈愿列表副程序7================
Sub SearchList()
sql="select * from wish order by date desc"
changetable conn,sql,rs,1
'设定Action参数
if UserName <> "" then
Action = "EditWish"
else
Action = "detail"
end if
i = 1
'显示
Do While Not Rs.eof and i <= ListNum
Response.Write "<IMG SRC='http://cfan.net.cn/info/"&PicPath&"List.gif' " _
&"BORDER='0'> <A HREF='index.asp?id="&Rs("id")&"&Action="&Action&"' " _
&" TITLE='点击后会单独出现'>" _
&Left(Rs("name"),10)&" "&Rs("sex")&"</A><BR>"
'鼠标下移逐条读出
Rs.MoveNext
i = i+1
Loop
End Sub
%>
<%
''================管理登入界面副程序8================
Sub login1()
'Request.ServerVariables("URL")是取得本页的路径，这里可以使用空值如：action=""
Response.Write "<FORM method='post' action='"&Request.ServerVariables("URL")&"'>"
Response.Write "<input type='hidden' name='Action' VALUE='login2'>"
Response.Write "用户：<input class='input2' type='text' size='12' name='name'><BR>"
Response.Write "密码：<input class='input2' type='Password' size='12' name='PW'><P>"
Response.Write "<INPUT class='Submit' type='submit' value='登入管理'>"
Response.Write "</FORM>"
End Sub
%>
<%
''================管理登入验证副程序9================
Sub login2() '验证
PW = Request.form("PW")
name = Request.form("name")
if PW = "" or name = "" then
notice = "请输入完整信息。"
ToUrl = "history.go(-1)"
elseif PW <> Password or name <> User then
notice = "输入错误，无权登入。"
ToUrl = "history.go(-1)"
else
notice = "登 入 成 功 ！"
ToUrl = "window.location='index.asp'"
Session("User") = name
end if
Call prompt(notice,ToUrl)
End Sub
%>
<%
'================删除祈愿副程序10================
Sub delWish()
Sql = "delete * from [wish] where id = "&id&""
Call changetable(conn,sql,rs,3)
Call prompt("您已经成功删除了编号为 "&id&" 的祈愿瓶！",ToUrl)
End Sub
%>
<%
''================退出管理副程序11================
Sub logout()
Session.Abandon '完整释放Session
UserName = ""
End Sub
%>
<%
''================说明文副程序12================
Sub explain() '显示在网页的左边单元个内
Response.Write "" _
&"<Li>点击瓶子可查看。</LI>" _
&"<Li>查看会记录点数。</LI>" _
&"<Li>流速更具有变化。</LI>" _
&"<Li>较为完整的提示。</LI>" _
&"<Li>可根据条件搜索。</LI>" _
&"<Li>搜索后瓶子同速<BR>缓慢流动便于查看。</LI>" _
&"<Li>可做用户名密码<BR>链接，及其它设定。</LI>" _
&"<Li>管理登入后，点<BR>击瓶后编号可删除，<BR>点击瓶子可修改。</LI>" _
&"<Li>搜索性别先生=男<BR>性，小姐=女性”。</LI>" _
&"<p ALIGN='center'><b>单 用 户 版</b>"
End Sub
%>
<%
'================页头信息副程序13================
Sub top()
Response.Write "<a href='http://"&homepage&"' title='"&MyWeb&"'>" _
&"<img src='http://cfan.net.cn/info/"&picPath&"logo.gif' border='0'></a>"
End Sub
%>
<%
'================版权声明副程序14================
Sub bottom()
CR = "2YUP Wish Board Bottle" _
&Chr(13)&"中文名字：(日式祈愿板或少女祈愿版) 之 祈愿漂流瓶" _
&Chr(13)&"版本编号：HP Wish Ver1.0 " _
&Chr(13)&"版本类型：多用户正式版 (简体中文)" _
&Chr(13)&"程序制作：轻轻飘过~ 之 8chinaasp" _
&Chr(13)&"版面设计：SLIGHTBOY 2.0 U 020820" _
&Chr(13)&"CopyRight (c) 2003-2004 "&homepage&".All Rights Reserved" _
&Chr(13)&"请尊重著作者劳动 保留以上版权信息 谢谢合作" _
&Chr(13)&"（请按此处登入管理）"
Response.Write "" _
&"<div align='center'><center>" _
&"<table border='0' cellpadding='0' cellspacing='0' width='400'>" _
&"<tr>" _
&"<td align='center'>" _
&"<a href='index.asp?action=login1'>" _
&"<img src=http://cfan.net.cn/info/"&picPath&"cr.gif width=280 height=9 border=0 title='"&CR&"'>" _
&"</a>" _
&"<td align='right'>" _
&"</tr>" _
&"" _
&"</center></div>"
End Sub
%>
呵呵呵。。。终于完成了，我现在准备给大家提供下载链接。
[说明]：
本漂流瓶注重制作流程，对于副程式和函数部分仅提供参考。
1、漂流瓶Ver1.0 演示1[演示密码和用户名都是：8chinaasp]
1、漂流瓶Ver1.0 演示2[演示密码和用户名都是：8chinaasp]
1、漂流瓶Ver1.0 下载
谢谢老大提供下载空间。
……