📄 guest_syscode.asp
字号:
<%@language=vbscript codepage=936 %>
<%
option explicit
response.buffer=false
'强制浏览器重新访问服务器下载页面，而不是从缓存读取页面
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<!--#include file="../conn.asp"-->
<!--#include file="../conn_user.asp"-->
<!--#include file="../inc/ubbcode.asp"-->
<!--#include file="../inc/RegBBS.asp"-->
<!--#include file="../inc/md5.asp"-->
<!--#include file="../inc/function.asp"-->
<!--#include file="../inc/syscode_common.asp"-->
<!--#include file="Channel_Config.asp"-->
<!--#include file="Guest_Function.asp"-->
<%
dim rsGuest,sqlGuest,sql,rs,CheckNum,CheckUrl
dim WriteName,WriteType,WriteSex,WriteEmail,WriteOicq,WriteIcq,WriteMsn
dim WriteHomepage,WriteFace,WriteImages,WriteTitle,WriteContent,WriteIsPrivate
dim SaveEdit,SaveEditId,i
dim AdminReplyContent
dim GImagePath,GFacePath,GEmotPath
dim keyword,skinid
SaveEdit=0
Const MaxPerPage=6
GImagePath=strInstallDir & "GuestBook/Images/"
GFacePath=strInstallDir & "GuestBook/Images/Face/"
GEmotPath=strInstallDir & "GuestBook/Images/Emote/"
FileName="index.asp"
keyword = Trim(Request("keyword"))
strFileName=FileName & "?action=" & action & "&keyword=" & keyword
if keyword="" then
select case Action
case "write"
PageTitle="签写留言"
case "savewrite"
PageTitle="保存留言"
case "reply"
PageTitle="回复留言"
case "edit"
PageTitle="编辑留言"
case "del"
PageTitle="删除留言"
case else
PageTitle="查看留言"
end select
else
Keyword = ReplaceBadChar(Keyword)
PageTitle="留言搜索：含有 <font color=red>"&keyword&"</font> 的留言"
end if
'=================================================
'过程名：GuestBook_Left()
'作 用：显示左侧留言功能
'参 数：无
'=================================================
function GuestBook_Left()
dim grs,strLeft
strLeft="<br>"
set grs=conn.execute("select count(*) from PE_Guest where GuestIsPassed=" & PE_False & "")
if UserLogined=True then
strLeft=strLeft & " 留言模式：<font color=green>用户模式</font>" & vbcrlf
else
strLeft=strLeft & " 留言模式：<font color=green>游客模式</font>" & vbcrlf
end if
if EnableCheck=True then
strLeft=strLeft & " 发表模式：<font color=green>审核发表</font>" & vbcrlf
strLeft=strLeft & " 待审留言：<font color=red>"&grs(0)&"</font> 条" & vbcrlf
else
strLeft=strLeft & " 发表模式：<font color=green>直接发表</font>" & vbcrlf
end if
set grs=nothing
if UserLogined=True then
strLeft=strLeft & "<div align='center'><a href='" & FileName & "?action=user' >【我的留言】</a></div>"
end if
strLeft=strLeft & "<div align='center'><a href='" & FileName & "' >【查看留言】</a></div>" & vbcrlf
strLeft=strLeft & "<div align='center'><a href='" & FileName & "?action=write' >【签写留言】</a></div><br>" & vbcrlf
GuestBook_Left=strLeft
end function
'=================================================
'过程名：GuestBook_Search()
'作 用：显示留言搜索
'参 数：无
'=================================================
function GuestBook_Search()
dim strGuestSearch
strGuestSearch="<table border='0' cellpadding='0' cellspacing='0'>"
strGuestSearch=strGuestSearch & "<form method='post' name='SearchForm' action='" & FileName & "'>"
strGuestSearch=strGuestSearch & "<tr><td height='40' >"
strGuestSearch=strGuestSearch & " <input type='text' name='keyword' size='15' value='关键字' maxlength='50' onFocus='this.select();'> "
strGuestSearch=strGuestSearch & "<input type='submit' name='Submit' value='搜索'>"
strGuestSearch=strGuestSearch & "</td></tr></form></table>"
GuestBook_Search=strGuestSearch
end function
'=================================================
'过程名：GuestBook()
'作 用：留言本功能调用
'参 数：无
'=================================================
sub GuestBook()
select case Action
case "write"
call WriteGuest()
case "savewrite"
call SaveWriteGuest()
case "reply"
call ReplyGuest()
case "edit"
call EditGuest()
case "del"
call DelGuest()
case "user"
call ShowAllGuest(3)
case else
call GuestMain()
end select
end sub
'=================================================
'过程名：GuestMain()
'作 用：留言主函数
'参 数：无
'=================================================
sub GuestMain()
if UserLogined=True then
ShowAllGuest(1)
else
ShowAllGuest(2)
end if
end sub
'=================================================
'过程名：ShowAllGuest()
'作 用：分页显示所有留言
'参 数：ShowType----- 0为显示所有
' 1为显示已通过审核及用户自己发表的留言
' 2为显示已通过审核的留言（用于游客显示）
' 3为显示用户自己发表的留言
'=================================================
sub ShowAllGuest(ShowType)
if ShowType=1 then
sqlGuest="select * from PE_Guest where (GuestIsPassed=" & PE_True & " or GuestName='"&UserName&"')"
elseif ShowType=2 then
sqlGuest="select * from PE_Guest where GuestIsPassed=" & PE_True & ""
elseif ShowType=3 then
sqlGuest="select * from PE_Guest where GuestName='"&UserName&"'"
elseif ShowType=4 then
sqlGuest="select * from PE_Guest where GuestIsPassed=" & PE_False & ""
else
if keyword<>"" then
sqlGuest="select * from PE_Guest where 1=1"
else
sqlGuest="select * from PE_Guest"
end if
end if
if keyword<>"" then
sqlGuest=sqlGuest & " and (GuestTitle like '%" & keyword & "%' or GuestContent like '%" & keyword & "%' or GuestName like '%" & keyword & "%' or GuestReply like '%" & keyword & "%') "
end if
sqlGuest=sqlGuest&" order by GuestMaxId desc"
set rsGuest=server.createobject("adodb.recordset")
rsGuest.open sqlGuest,conn,1,1
if rsGuest.bof and rsGuest.eof then
totalput=0
response.write "<br><li>没有任何留言</li>"
else
totalput=rsGuest.recordcount
if currentpage<1 then
currentpage=1
end if
if (currentpage-1)*MaxPerPage>totalput then
if (totalPut mod MaxPerPage)=0 then
currentpage= totalPut \ MaxPerPage
else
currentpage= totalPut \ MaxPerPage + 1
end if
end if
if currentPage>1 then
if (currentPage-1)*MaxPerPage<totalPut then
rsGuest.move (currentPage-1)*MaxPerPage
else
currentPage=1
end if
end if
call ShowGuestList()
end if
if totalput>0 then
response.write showpage(strFileName,totalput,MaxPerPage,true,true,"条留言")
end if
rsGuest.close
set rsGuest=nothing
end sub
'=================================================
'过程名：ShowGuestList()
'作 用：显示留言
'参 数：无
'=================================================
sub ShowGuestList()
dim UserGuestName,UserType,UserSex,UserEmail,UserHomepage,UserOicq,UserIcq,UserMsn
dim GuestNum,GuestTip,TipName,TipSex,TipEmail,TipOicq,TipHomepage,isdelUser
GuestNum=0
response.write showtip()
strHTML=""
do while not rsGuest.eof
isdelUser=0
if rsGuest("GuestType")=1 then
dim rsUser
set rsUser=Conn_User.execute("select * from " & db_User_Table & " where " & db_User_Name & "='" & ReplaceBadChar(rsGuest("GuestName")) & "'")
if not (rsUser.bof and rsUser.eof) then
UserGuestName=rsUser(db_User_Name)
UserSex=rsUser(db_User_Sex)
UserEmail=rsUser(db_User_Email)
'增加对整合动网7.0版本论坛用户资料（IM）的处理
If UserTableType="Dvbbs7.0" then
Dim UserIM
UserIM=split(rsUser("UserIM"),"|||")
UserHomepage=UserIM(0)
UserOicq=UserIM(1)
UserMsn=UserIM(2)
Else
UserOicq=rsUser(db_User_QQ)
UserIcq=rsUser(db_User_Icq)
UserMsn=rsUser(db_User_Msn)
UserHomepage=rsUser(db_User_Homepage)
End if
'完毕
else
isdelUser=1
end if
set rsUser=nothing
end if
if rsGuest("GuestType")<>1 or isdelUser=1 then
UserGuestName=rsGuest("GuestName")
UserSex=rsGuest("GuestSex")
UserEmail=rsGuest("GuestEmail")
UserOicq=rsGuest("GuestOicq")
UserIcq=rsGuest("GuestIcq")
UserMsn=rsGuest("GuestMsn")
UserHomepage=rsGuest("GuestHomepage")
end if
TipName=UserGuestName
if isdelUser=1 then TipName=TipName&"（已删除）"
if UserEmail="" or isnull(UserEmail) then
TipEmail="未填"
else
TipEmail=UserEmail
end if
if UserOicq="" or isnull(UserOicq) then
TipOicq="未填"
else
TipOicq=UserOicq
end if
if UserHomepage="" or isnull(UserHomepage) then
TipHomepage="未填"
else
TipHomepage=UserHomepage
end if
if UserIcq="" or isnull(UserIcq) then UserIcq="未填"
if UserMsn="" or isnull(UserMsn) then UserMsn="未填"
if UserSex=1 then
TipSex="（酷哥）"
elseif UserSex=0 then
TipSex="(靓妹)"
else
TipSex=""
end if
GuestTip=" 姓名：" & TipName & " "&TipSex&"<br> 主页："&TipHomepage&"<br> OICQ："&TipOicq&"<br> 信箱："&TipEmail&"<br> 地址："&rsGuest("GuestIP")&"<br> 时间："&rsGuest("GuestDatetime")
strHTML=strHTML & " <table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>" & vbcrlf
strHTML=strHTML & " <tr>" & vbcrlf
strHTML=strHTML & " <td align='center' valign='top'>" & vbcrlf
strHTML=strHTML & " <table width='100%' border='0' cellspacing='0' cellpadding='0' class='main_title_575'>" & vbcrlf
strHTML=strHTML & " <tr>" & vbcrlf
strHTML=strHTML & " <td>" & vbcrlf
strHTML=strHTML & " <font color=green>主题：</font> " & KeywordReplace(rsGuest("GuestTitle")) & vbcrlf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -