%
Head()
Dim admin_flag
Dim action
Dim sqlstr,l_type
l_type=request("l_type")
admin_flag=",3,"
If Not Dvbbs.master or instr(","&session("flag")&",",admin_flag)=0 then
Errmsg=ErrMsg + "
本页面为管理员专用,请登录后进入。
您没有管理本页面的权限。"
dvbbs_error()
Else
If Request("action")="dellog" Then
batch()
Else
Select Case l_type
Case "3"
sqlstr=" where l_type=3 "
l_type=3
main
Case "4"
sqlstr=" where l_type=4 "
l_type=4
main
Case "5"
sqlstr=" where l_type=5 "
l_type=5
main
Case "6"
sqlstr=" where l_type=6 "
l_type=6
main
Case "0"
sqlstr=" where l_type=0 "
l_type=0
main
Case "1"
sqlstr=" where l_type=1 "
l_type=1
main
Case "2"
sqlstr=" where l_type=2 "
l_type=2
main
Case Else
sqlstr=""
l_type=""
main
End Select
End If
If founderr then call dvbbs_error()
footer()
End If
Sub main()
Dim l_boardID
l_boardID=Request("l_boardID")
If l_boardID="" Then l_boardID="0"
If l_boardID<> 0 Then
If sqlstr <> "" Then
sqlstr=sqlstr &" and l_boardID="&l_boardID
Else
sqlstr=" where l_boardID="&l_boardID
End If
End If
Dim keyword,checkvalue
checkvalue=Dvbbs.Checkstr(Request("checkvalue"))
keyword=Dvbbs.checkstr(Request("keyword"))
If keyword <> "" Then
If checkvalue="" Then
If sqlstr <> "" Then
sqlstr=sqlstr &" and (l_touser like '%"&keyword&"%' Or l_content like '%"&keyword&"%' Or l_ip like '%"&keyword&"%' Or l_username like '%"&keyword&"%')"
Else
sqlstr=" where l_touser like '%"&keyword&"%' Or l_content like '%"&keyword&"%' Or l_ip like '%"&keyword&"%' Or l_username like '%"&keyword&"%'"
End If
Else
If sqlstr <> "" Then
sqlstr=sqlstr &" and "& checkvalue &" like '%"&keyword&"%'"
Else
sqlstr=" where "& checkvalue &" like '%"&keyword&"%'"
End If
End If
End If
%>
<%
Dim pagestr
Dim currentpage,page_count,Pcount,endpage
Dim sql,Rs,totalrec
currentPage=request("page")
If currentpage="" or not IsNumeric(currentpage) Then
currentpage=1
Else
currentpage=clng(currentpage)
End If
pagestr="?keyword="&Request("keyword")&"&l_type="& Request("l_type") &"&checkvalue="&Request("checkvalue") &"&l_boardID=" &Request("l_boardID")&"&"
Dvbbs.Forum_Setting(11)=50
sql="select * from [dv_log] "&sqlstr&" order by l_addtime desc"
'Response.Write SQL
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
Response.Write ""
Response.Write ""
Response.Write "
"
Rs.close
Set rs=Nothing
End Sub
Sub batch()
Dim lid
If request("act")="删除" Then
If request.form("lid")="" Then
DVbbs.AddErrmsg "请指定相关事件。"
Else
lid=replace(request.Form("lid"),"'","")
lid=replace(lid,";","")
lid=replace(lid,"--","")
lid=replace(lid,")","")
End If
End if
If request("act")="删除" Then
Dvbbs.Execute("delete from dv_log where Datediff(""D"",l_addtime, "&SqlNowString&") > 2 and l_id in ("&lid&")")
ElseIf request("act")="清空日志" Then
If request("l_type")="" or IsNull(request("l_type")) Then
If IsSqlDataBase = 1 Then
Dvbbs.Execute("delete from dv_log Where Datediff(D,l_addtime, "&SqlNowString&") > 2")
else
Dvbbs.Execute("delete from dv_log Where Datediff('D',l_addtime, "&SqlNowString&") > 2")
end if
Else
If IsSqlDataBase = 1 Then
Dvbbs.Execute("delete from dv_log where Datediff(D,l_addtime, "&SqlNowString&") > 2 and l_type="&CInt(request("l_type"))&"")
else
Dvbbs.Execute("delete from dv_log where Datediff('D',l_addtime, "&SqlNowString&") > 2 and l_type="&CInt(request("l_type"))&"")
end if
End If
End If
Dv_suc("成功删除日志。注意:两天内的日志会被系统保留。")
End Sub
'关键字突出显示 by 轻飘飘
Function HighLigth(Str,keyword)
If keyword="" Then
HighLigth=Str
Exit Function
End IF
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="("&keyword&")"
HighLigth=re.Replace(Str,"$1")
End Function
'URL解码函数 by 轻飘飘
Function URLDecode(enStr)
On Error Resume Next
Dim deStr,c,i,v:deStr=""
For i=1 to len(enStr)
c=Mid(enStr,i,1)
If c="%" Then
v=eval("&h"+Mid(enStr,i+1,2))
If v<128 Then
deStr=deStr&Chr(v)
i=i+2
Else
If isvalidhex(Mid(enstr,i,3)) Then
If isvalidhex(Mid(enstr,i+3,3)) Then '这个判断检测是否双字节--不是
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&Chr(v)
i=i+5
Else
v=eval("&h"+Mid(enStr,i+1,2)+Cstr(Hex(Asc(Mid(enStr,i+3,1))))) '--是
deStr=deStr&Chr(v)
i=i+3
End If
Else
destr=destr&c
End If
End If
Else
If c="+" Then
deStr=deStr&" "
Else
deStr=deStr&c
End If
End If
Next
URLDecode=deStr
End Function
Function IsValidHex(str)
Dim c
IsValidHex=True
str=UCase(str)
If Len(str)<>3 Then
IsValidHex=False
Exit Function
End If
If Left(str,1)<>"%" Then
IsValidHex=False
Exit Function
End If
c=Mid(str,2,1)
If Not (((c>="0") And (c<="9")) Or ((c>="A") And (c<="Z"))) Then
IsValidHex=False
Exit Function
End If
c=Mid(str,3,1)
If Not (((c>="0") And (c<="9")) Or ((c>="A") And (c<="Z"))) Then
IsValidHex=False
Exit Function
End If
End Function
%>