📄 func_guest.asp
字号:
<input type="hidden" name="GuestImages" value="<%=WriteImages%>">
<img name=showimages src="<%=GuestPath%><%=WriteImages%>.gif" width="80" height="90" border="0" onClick=window.open("guestselect.asp?action=guestimages","face","width=480,height=400,resizable=1,scrollbars=1") title=点击选择头像 style="cursor:hand">
<select name="Image" size="1" onChange="changeimage();" >
<%
for i=1 to 9
response.write "<option value='0"&i&"'>0"&i&"</option>"
next
for i=10 to 23
response.write "<option value='"&i&"'>"&i&"</option>"
next
%>
</select>
</td>
<td> </td>
<td> </td>
<td> </td>
</tr>
<%end if%>
<tr>
<td align="center">留言主题:</td>
<td colspan="4">
<input type="text" name="GuestTitle" size="37" maxlength="28" value="<%=WriteTitle%>">
<font color=red>*</font>
</td>
</tr>
<tr>
<td align="center">现在心情:</td>
<td colspan="4">
<%
for i=1 to 20
response.write "<input type=""radio"" name=""GuestFace"" value="&i&""
if i=clng(WriteFace) then response.write " checked"
response.write " style=""BORDER:0px;width:19;"">"
response.write "<img src="""&GuestPath&"face"&i&".gif"" width=""19"" height=""19"">"& vbcrlf
if i mod 10 =0 then response.write "<br>"
next
%>
</td>
</tr>
<tr>
<td align="center"><input type="checkbox" name="ubb" value="1" onClick=showubbinfo() style="BORDER:0px;" onfocus="this.blur()"><span id=ubbinfoshowtext>UBB开关</span>
<td colspan="4" style="DISPLAY: none" id="ubbinfo">
<% call showubb()%>
</td>
</tr>
<tr>
<td valign="middle" align="center">留言内容: <br>
</td>
<td colspan="4" valign="top">
<textarea name="GuestContent" cols="61" rows="6" onkeydown=gbcount(this.form.GuestContent,this.form.total,this.form.used,this.form.remain); onkeyup=gbcount(this.form.GuestContent,this.form.total,this.form.used,this.form.remain);><%=WriteContent%></textarea>
</td>
</tr>
<tr>
<td valign="middle" align="center"></td>
<td colspan="4" valign="top">
最多字数：<INPUT disabled maxLength=4 name=total size=3 value=500>
已用字数：<INPUT disabled maxLength=4 name=used size=3 value=0>
剩余字数：<INPUT disabled maxLength=4 name=remain size=3 value=500>
</td>
</tr>
<tr>
<td valign="middle" align="center">是否隐藏：</td>
<td colspan="4" valign="top">
<input type="radio" name="GuestIsPrivate" value="no" checked style="BORDER:0px;">
正常
<input type="radio" name="GuestIsPrivate" value="yes" style="BORDER:0px;">
隐藏 <font color=#009900>*</font> 选择隐藏后，此留言只有管理员和留言者才可以看到。</td>
</tr>
<tr>
<td colspan="5" align="center" height="40">
<input type="hidden" name="saveedit" value="<%=SaveEdit%>">
<input type="hidden" name="saveeditid" value="<%=SaveEditId%>">
<input type="submit" name="Submit1" value=" 发 表" >
<input type="button" name="Submit2" value=" 预 览 " onclick=guestpreview()>
<input type="reset" name="Submit3" value=" 重 填 " >
</td>
</tr>
</form>
<form name=preview action="GuestPreview.asp" method=post target=GuestPreview>
<input type=hidden name=title value=><input type=hidden name=content value=>
</form>
</table>
</td>
</tr>
</table>
<%
end sub
'=================================================
'过程名：ReplyGuest()
'作 用：回复留言
'参 数：无
'=================================================
sub ReplyGuest()
dim ReplyId
ReplyId=request("guestid")
if ReplyId="" then
call Guest_info("<li>请指定要回复的留言ID！</li>")
exit sub
else
ReplyId=clng(ReplyId)
sqlGuest="select * from Guest where GuestId=" & ReplyId
end if
set rsGuest=server.createobject("adodb.recordset")
rsGuest.open sqlGuest,conn,1,1
if rsGuest.bof and rsGuest.eof then
response.write "<br><img src='skin/1/xiao.gif'>没有任何留言"
exit sub
else
WriteTitle="Re: "&rsGuest("GuestTitle")
call ShowGuestList()
end if
rsGuest.close
set rsGuest=nothing
call WriteGuest()
end sub
'=================================================
'过程名：EditGuest()
'作 用：编辑留言
'参 数：无
'=================================================
sub EditGuest()
dim EditId
EditId=request("guestid")
if EditId="" then
call Guest_info("<li>请指定要编辑的留言ID！</li>")
exit sub
else
EditId=clng(EditId)
sqlGuest="select * from Guest where GuestId=" & EditId
end if
set rsGuest=server.createobject("adodb.recordset")
rsGuest.open sqlGuest,conn,1,1
if rsGuest.bof and rsGuest.eof then
response.write "<br>找不到您指定的留言！"
exit sub
end if
if rsGuest("GuestName")=LoginName and rsGuest("GuestIsPassed")=False then
WriteName=rsGuest("GuestName")
WriteType=rsGuest("GuestType")
WriteSex=rsGuest("GuestSex")
WriteEmail=rsGuest("GuestEmail")
WriteOicq=rsGuest("GuestOicq")
WriteIcq=rsGuest("GuestIcq")
WriteMsn=rsGuest("GuestMsn")
WriteHomepage=rsGuest("GuestHomepage")
WriteFace=rsGuest("GuestFace")
WriteImages=rsGuest("GuestImages")
WriteTitle=rsGuest("GuestTitle")
WriteContent=rsGuest("GuestContent")
SaveEdit=1
SaveEditId=EditId
call ShowGuestList()
call WriteGuest()
else
call Guest_info("<li>用户只可以编辑自己发表的留言，且留言未通过审核！</li>")
end if
rsGuest.close
set rsGuest=nothing
end sub
'=================================================
'过程名：DelGuest()
'作 用：删除留言
'参 数：无
'=================================================
sub DelGuest()
dim delid
delid=trim(Request("guestid"))
if delid="" then
call Guest_info("<img src='skin/1/xiao.gif'>请指定要删除的留言ID！")
exit sub
end if
if instr(delid,",")>0 then
delid=replace(delid," ","")
sql="Select * from Guest where GuestID in (" & delid & ")"
else
delid=clng(delid)
sql="select * from Guest where GuestID=" & delid
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open sql,conn,1,3
if rs.bof and rs.eof then
response.write "<br><img src='skin/1/xiao.gif'>找不到您指定的留言！"
exit sub
end if
if rs("GuestName")<>LoginName or rs("GuestIsPassed")=True then
call Guest_info("<li>您没有使用此功能的权限！</li>")
else
do while not rs.eof
rs.delete
rs.update
rs.movenext
loop
rs.close
set rs=nothing
call Guest_info("<img src='skin/1/xiao.gif'>删除留言成功！")
end if
end sub
'=================================================
'过程名：ShowGuestbutton()
'作 用：显示留言功能按钮
'参 数：无
'=================================================
sub ShowGuestButton()
response.write "<table width=100% border=0 cellpadding=0 cellspacing=3><tr>"
response.write "<td nowarp>"
if UserHomepage="" or isnull(UserHomepage) then
response.write "<img src="&GuestPath&"nourl.gif width=45 height=16 alt="&UserGuestName&"没有留下主页地址 border=0>" & vbcrlf
else
response.write "<a href="&UserHomepage&" target=""_blank"">"
response.write "<img src="&GuestPath&"url.gif width=45 height=16 alt="&UserHomepage&" border=0></a>" & vbcrlf
end if
if UserOicq="" or isnull(UserOicq) then
response.write "<img src="&GuestPath&"nooicq.gif width=45 height=16 alt="&UserGuestName&"没有留下QQ号码 border=0>" & vbcrlf
else
response.write "<a href=http://search.tencent.com/cgi-bin/friend/user_show_info?ln="&UserOicq&" target=""_blank"">"
response.write "<img src="&GuestPath&"oicq.gif width=45 height=16 alt="&UserOicq&" border=0 ></a>" & vbcrlf
end if
if UserEmail="" or isnull(UserEmail) then
response.write "<img src="&GuestPath&"noemail.gif width=45 height=16 alt="&UserGuestName&"没有留下Email地址 border=0>" & vbcrlf
else
response.write "<a href=mailto:"&UserEmail&">"
response.write "<img src="&GuestPath&"email.gif width=45 height=16 border=0 alt="&UserEmail&"></a>" & vbcrlf
end if
response.write "<img src="&GuestPath&"other.gif width=45 height=16 border=0 onMouseOut=toolTip() onMouseOver=""toolTip(' Icq：" & UserIcq & "<br> Msn：" & UserMsn & "<br> I P：" &rsGuest("GuestIP")&"')"">" & vbcrlf
response.write "<a href="&strFileName&"?action=reply&guestid="&rsGuest("GuestId")&">"
response.write "<img src="&GuestPath&"reply.gif width=45 height=16 border=0 alt=回复这条留言></a>" & vbcrlf
if rsGuest("GuestName")=LoginName and rsGuest("GuestIsPassed")=False then
response.write "<a href="&strFileName&"?action=edit&guestid="&rsGuest("GuestId")&">"
response.write "<img src="&GuestPath&"edit.gif width=45 height=16 border=0 alt=编辑这条留言></a>" & vbcrlf
response.write "<a href="&strFileName&"?action=del&guestid="&rsGuest("GuestId")&" onClick=""return confirm('确定要删除此留言吗？');"">"
response.write "<img src="&GuestPath&"del.gif width=45 height=16 alt=删除这条留言 border=0></a>" & vbcrlf
end if
response.write "</td>"
response.write "</tr></table>"
end sub
'=================================================
'过程名：Show_super_Menu
'作 用：显示下拉菜单效果 -来自异域-晓炊改进
'参 数：无
'=================================================
sub Show_super_Menu()
dim sqlRoot,rsRoot,tdstyle,tdmouse,sqlClass,rsClass,k
tdstyle=" style='background-image: url(images/menu_bg1.gif);background-repeat: no-repeat;background-position: right;letter-spacing: 2px' "
' tdmouse=" onmouseover='this.style.background-image: url(images/menu_bg1.gif)' onmouseout='this.style.background-image: url(images/menu_bg1.gif)' "
sqlRoot="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child,C.Readme,c.parentID From ArticleClass C"
sqlRoot= sqlRoot & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth=0 and C.ShowOnTop=True order by C.RootID"
Set rsRoot= Server.CreateObject("ADODB.Recordset")
rsRoot.open sqlRoot,conn,1,1
response.write "<table border='0' cellpadding='0' cellspacing='0' width='100%' height='100%'>"
' response.write "<a href=index.asp><td width='1%' nowrap" & tdstyle & tdmouse & " style='CURSOR: hand'> 首 页 </td><a>"
if not(rsRoot.bof and rsRoot.eof) then
do while not rsRoot.eof
if rsRoot(6)>0 then
response.write "<A href='info_class.asp?classID=" & rsRoot(0) & "'><TD width='1%' nowrap" & tdstyle & tdmouse & " id=Menu" & rsRoot(0) & " style='CURSOR: hand'> " & rsRoot(1) & " </TD></A>" & vbcrlf
else
response.write "<a href='info_class.asp?classID=" & rsroot(0) & "'><td width='1%' nowrap" & tdstyle & tdmouse & " style='CURSOR: hand'> " & rsroot(1) & " </td></a>" & vbcrlf
end if
rsRoot.movenext
loop
end if
rsRoot.close
set rsRoot=nothing
response.write "<td width='90%'> </td></tr></table>"
%>
<script language="javascript">
if (mtDropDown.isSupported()) {
var ms = new mtDropDownSet(mtDropDown.direction.down, 0, 0, mtDropDown.reference.bottomLeft);
<%
sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child,C.Readme,C.parentID From ArticleClass C" &_
" inner join Layout L on C.LayoutID=L.LayoutID where C.Depth=0 and C.ShowOnTop=True and C.Child>0 order by C.RootID"
Set rsClass= Server.CreateObject("ADODB.Recordset")
rsClass.open sqlClass,conn,1,1
do while not rsClass.eof
response.write "var Menu" & rsClass(0) & "=ms.addMenu(document.getElementById(""" & "Menu" & rsClass(0) & """));" & vbcrlf
call GetSuperMenu(rsClass(0))
rsClass.movenext
loop
rsClass.close
set rsClass=nothing
%>
mtDropDown.renderAll();
}
</script>
<%
end sub
sub GetSuperMenu(ID) '--被上面的调用，递归...
dim sqlClass,rsClass,k
sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child,C.Readme,C.parentID From ArticleClass C" &_
" inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & ID & " order by C.OrderID asc"
Set rsClass= Server.CreateObject("ADODB.Recordset")
rsClass.open sqlClass,conn,1,1
k=0
do while not rsClass.eof
response.write " Menu" & ID & ".addItem(' " & rsClass(1) & "','info_class.asp?classID=" & rsClass(0) & "');" & vbcrlf
if rsClass(6)>0 then
response.write "var Menu" & rsClass(0) & " = Menu" & rsClass(8) & ".addMenu(Menu" & rsClass(8) & ".items[" & k & "]);" & vbcrlf
call GetSuperMenu(rsClass(0))
end if
k=k+1
rsClass.movenext
loop
rsClass.close
set rsClass=nothing
end sub
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -