📄 admin_guestbook.asp
字号:
Case "CancelPassed"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(3, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
If rsProperty("TopicID") <> rsProperty("GuestID") Then
Set rsReplyNum = Conn.Execute("select count(GuestID) from PE_GuestBook where TopicID =" & rsProperty("TopicID") & " and GuestIsPassed=" & PE_True & "")
ReplyNumCount = rsReplyNum(0) - 2
Set rsReplyNum = Nothing
Conn.Execute ("update PE_GuestBook set ReplyNum=" & ReplyNumCount & " where GuestId=" & rsProperty("TopicID") & "")
End If
rsProperty("GuestIsPassed") = False
End If
Case "Quintessence"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(4, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
rsProperty("Quintessence") = 1
End If
Case "Cquintessence"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(4, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
rsProperty("Quintessence") = 0
End If
Case "SetOnTop"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(5, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
rsProperty("OnTop") = 1
End If
Case "CancelOnTop"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(5, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
rsProperty("OnTop") = 0
End If
Case "DelReply"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(6, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
rsProperty("GuestReply") = ""
End If
Case "Del"
If AdminPurview = 2 And AdminPurview_GuestBook = 3 And CheckKindPurview(1, rsProperty("KindID")) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>对 " & rsProperty("GuestTitle") & " 没有操作权限！</li>"
Else
If rsProperty("TopicID") <> rsProperty("GuestID") Then
Dim TopicID
TopicID = rsProperty("TopicID")
rsProperty.Delete
Set rs = Server.CreateObject("adodb.recordset")
sql = "select top 1 * from PE_GuestBook where GuestId=" & TopicID
rs.Open sql, Conn, 1, 3
If Not(rs.EOF And rs.BOF) Then
Dim trs
'Set trs = Conn.Execute("select top 1 * from PE_GuestBook where TopicID=" & TopicID & " order by GuestMaxId desc")
Set trs = Conn.Execute("select top 1 * from PE_GuestBook where TopicID=" & TopicID & " AND GuestId<>" & TopicId &" order by GuestMaxId desc")
If Not(trs.bof And trs.eof) then
rs("LastReplyContent") = trs("GuestContent")
rs("LastReplyGuest") = trs("GuestName")
rs("LastReplyTitle") = trs("GuestTitle")
rs("LastReplyTime") = trs("GuestDatetime")
Else
rs("LastReplyContent") = ""
rs("LastReplyGuest") = ""
rs("LastReplyTitle") = ""
rs("LastReplyTime") = Now()
End If
trs.close
Set trs = nothing
rs("ReplyNum") = rs("ReplyNum") - 1
rs.Update
End If
rs.Close
Else
Conn.Execute ("delete from PE_GuestBook where TopicID=" & rsProperty("TopicID") & "")
End If
End If
End Select
rsProperty.Update
rsProperty.MoveNext
Loop
rsProperty.Close
Set rsProperty = Nothing
Call ClearSiteCache(4)
Call CloseConn
If FoundErr = True Then
Exit Sub
End If
Response.Redirect ComeUrl
End Sub
Sub ShowGuestList()
Dim UserGuestName, UserType, UserSex, UserEmail, UserHomepage, UserOicq, UserIcq, UserMsn
Dim GuestNum, GuestTip, TipName, TipSex, TipEmail, TipOicq, TipHomepage, isdelUser
GuestNum = 0
Call ShowTip
Do While Not rsGuest.EOF
isdelUser = 0
If rsGuest("GuestType") = 1 Then
Dim rsUser
Set rsUser = Conn.Execute("select * from PE_Contacter where ContacterID=(select ContacterID from PE_User where UserName='" & ReplaceBadChar(rsGuest("GuestName")) & "')")
If Not (rsUser.BOF And rsUser.EOF) Then
UserGuestName = rsGuest("GuestName")
UserSex = rsUser("Sex")
UserEmail = rsUser("Email")
UserOicq = rsUser("QQ")
UserIcq = rsUser("ICQ")
UserMsn = rsUser("MSN")
UserHomepage = rsUser("Homepage")
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")
Response.Write " <table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td align='center' valign='top'>" & vbCrLf
Response.Write " <table width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbCrLf
Response.Write " <tr class='title'>" & vbCrLf
Response.Write " <td height='22'>" & vbCrLf
Response.Write " <font color=green>主题：</font> " & rsGuest("GuestTitle") & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " <td width='165'>" & vbCrLf
Response.Write " <img src='" & GImagePath & "posttime.gif' width='11' height='11' align='absmiddle'>" & vbCrLf
Response.Write " <font color='#006633'>：" & rsGuest("GuestDatetime") & "</font>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td align='center' height='153' valign='top' class='tdbg'>" & vbCrLf
Response.Write " <table width='100%' border='0' cellpadding='0' cellspacing='3'>" & vbCrLf
If rsGuest("GuestIsPassed") = True Then
Response.Write " <tr>" & vbCrLf
Else
Response.Write " <tr>" & vbCrLf
End If
Response.Write " <td width='100' align='center' height='130' valign='top'>" & vbCrLf
Response.Write " <img src='" & GFacePath & rsGuest("GuestImages") & ".gif' width='80' height='90' onMouseOut=toolTip() onMouseOver=""toolTip('" & GuestTip & "')""><br><br>" & vbCrLf
If rsGuest("GuestType") = 1 Then
Response.Write " <font color='#006633'>【用户】<br>" & UserGuestName & "</font>"
Else
Response.Write " 【游客】<br>" & UserGuestName
End If
Response.Write " </td>" & vbCrLf
Response.Write " <td align='center' height='153' width='1' bgcolor='#B4C9E7'>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " <td>" & vbCrLf
Response.Write " <table width='100%' border='0' cellpadding='6' cellspacing='0' height='125' style='TABLE-LAYOUT: fixed'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td align='left' valign='top'><img src='" & GImagePath & "face" & rsGuest("GuestFace") & ".gif' width='19' height='19'>" & vbCrLf
If rsGuest("GuestIsPrivate") = True Then
Response.Write " <font color=green>[隐藏]</font> " & vbCrLf
End If
Response.Write FilterJS(rsGuest("GuestContent"))
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td align='left' valign='bottom'>" & vbCrLf
If rsGuest("GuestReply") <> "" Then
Response.Write " <table width='100%' border='0' cellspacing='0' cellpadding='2'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td height='1' bgcolor='#B4C9E7'></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td valign='top'>" & vbCrLf
Response.Write " <table width='100%' border='0' cellpadding='0' cellspacing='0' style='TABLE-LAYOUT: fixed'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td><font color='#006633'> 管理员<font color='#FF0000'>[" & rsGuest("GuestReplyAdmin") & "]</font>回复:" & vbCrLf & rsGuest("GuestReplyDatetime") & "</font></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td valign='bottom'><font color='#006633'>" & rsGuest("GuestReply") & "</font></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
End If
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " <table width='100%' height='1' border='0' cellpadding='0' cellspacing='0' bgcolor='#B4C9E7'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " <table width=100% border=0 cellpadding=0 cellspacing=3>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td>" & vbCrLf
If UserHomepage = "" Or IsNull(UserHomepage) Then
Response.Write "<img src=" & GImagePath & "nourl.gif width=45 height=16 alt=" & UserGuestName & "没有留下主页地址 border=0>" & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -