user_messages.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 446 行 · 第 1/2 页

<%
End Sub

Sub modify()
    Dim id
    Dim rsblog, sql
    Dim restr
    id = Trim(Request("id"))
    If id = "" Then
        oblog.adderrstr ("错误：参数不足！")
        oblog.showusererr
        Exit Sub
    Else
        id = Int(id)
    End If
    Set rsblog = server.CreateObject("Adodb.RecordSet")
    sql="select * from [oblog_message] where messageid=" & id&" and userid="&oblog.l_uid
    rsblog.open sql, conn, 1, 1
    If rsblog.EOF Then
        rsblog.Close
        Set rsblog = Nothing
        oblog.adderrstr ("错误：找不到指定的留言！")
        oblog.showusererr
        Exit Sub
    End If
%>
<SCRIPT language=javascript>
var ubbimg='';
</SCRIPT>
<form action="user_messages.asp?action=savemodify" method="post" name="oblogform" onSubmit="">
	<table  class="dTab12_body" align="center" border="0" cellpadding="0" cellspacing="1">
	  <tr>
	  	<%if Request("re") <> "true" then%>
		<td class="dTab12_body_td" style="text-align:left;">
<span class="user_post_inputtxt">留言标题:</span><input style="height:16px;padding:2px 0 0 0;margin:0px 0 -3px 0;" name="topic" type=text class="cont" id="topic" value="<%=rsblog("messagetopic")%>" size="53" maxlength="30" /><br /><br />
		<%else%>
		<td class="dTab12_body_td" style="text-align:left;">
<div class="messagetopic"><%=rsblog("messagetopic")%></div>
<div class="message"><%=oblog.ubb_comment(rsblog("message"))%></div><br /><br />
<div style="color:#CCC;margin:-10px 0 0 0px;">回复此留言:</div>
		<%end if%>
<style type='text/css'>@import url('editor/ubb.css');</style>
<Script src="editor/ubb.js"></Script>
<div id="oblog_ubb">
	<div class="oblog_ubbtoolbar" style="width:98%;">
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[B]','[/B]'),true);void(0)"><img src="images/bold.gif" alt="粗体"  border="0" align="absmiddle"></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[I]','[/I]'),true);void(0)"><img src="images/italic.gif" alt="斜体" border="0" align="absmiddle" ></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[U]','[/U]'),true);void(0)"><img src="images/underline.gif" alt="下划线" border="0" align="absmiddle"></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[QUOTE]','[/QUOTE]'),true);void(0)"><img src="images/quote.gif" alt="插入引用" border="0" align="absmiddle"></a>
	<a href="javascript:UBB_smiley();void(0)"><img src="images/smiley.gif" alt="插入表情" border="0" align="absmiddle" id="A_smiley"></a>
	</div>
	<div id="oblog_ubbemot">
	</div>
	  <textarea name="edit" style="border:0;width:100%x;"cols="92" rows="6" id="oblog_edittext" class="oblog_ubbtext" ><%if rsblog("message")<>"" and Request("re") <> "true" then response.Write Server.HtmlEncode(rsblog("message"))%></textarea>
</div>
<ul id="user_post_input">
<input type="hidden" name="id" value="<%=rsblog("messageid")%>" /><input type="hidden" name="re" value="<%=request("re")%>" /><input type="submit" name="Submit2" value=" 提交 " />
</ul>
</td>
	 </tr>
  </table>
</form>
<%
    rsblog.Close
    Set rsblog = Nothing
End Sub

Sub savemodify()
    Dim id, blog, userid
    id = Int(Trim(Request("id")))
    sql="select * from oblog_message where messageid="&id&" and userid="&oblog.l_uid
    Set rs = server.CreateObject("adodb.recordset")
    rs.open sql, conn, 1, 3
    If Not rs.EOF Then
        userid = rs("userid")
        if request("re")="true" then
			rs("message") = rs("message")&"[quote][b]以下为blog主人的回复：[/b]"&vbcrlf&oblog.filt_badword(Request("edit"))&"[/quote]"
		else
			rs("message") = oblog.filt_badword(Request("edit"))
			rs("messagetopic") = oblog.InterceptStr(oblog.filt_badword(Trim(Request("topic"))), 250)
		end if
        rs.Update
        rs.Close
        Set blog = New class_blog
        blog.userid = userid
        blog.Update_message 0
        Set rs = Nothing
        Set blog = Nothing
    End If
    oblog.showok "修改留言成功！", "user_messages.asp"
End Sub

Sub delmessage()
    If id = "" Then
        oblog.adderrstr ("错误：请指定要删除的留言！")
        oblog.showusererr
        Exit Sub
    End If
    If InStr(id, ",") > 0 Then
        Dim n, i
        id = FilterIDs(id)
        n = Split(id, ",")
        For i = 0 To UBound(n)
            delonemessage (n(i))
        Next
    Else
        delonemessage (id)
    End If
    Set rs = Nothing
    oblog.showok "删除留言成功!", ""
End Sub

Sub delonemessage(id)
    id = Int(id)
    Dim userid, messagefile
    'Response.Write "idgfgfgfgf" & id
  	'Response.End
    sql = "select * from [oblog_message] where messageid=" & Int(id) & " and userid=" & oblog.l_uId
    Set rs = server.CreateObject("adodb.recordset")
    rs.open sql, conn, 1, 3
    If Not rs.EOF Then
        userid = rs("userid")
        messagefile = rs("messagefile")
        rs.Delete
        rs.Close
        Set blog = New class_blog
        blog.userid = userid
        'blog.update_message 0,0,0,""
        blog.Update_message 0
        blog.Update_newmessage userid
        oblog.execute("update [oblog_user] set message_count=message_count-1,scores=scores-" & oblog.CacheScores(5)&" where userid="&userid)

        Set blog = Nothing
    Else
        rs.Close
        Set rs = Nothing
        oblog.adderrstr ("错误：无删除权限！")
        oblog.showusererr
        Exit Sub
    End If
End Sub

Sub ClearIpMessages(sIp)
    If sIp <> "" Then oblog.Execute ("Delete From oblog_message Where addIp='" & sIp & "' and userid=" & oblog.l_uId)
End Sub

Function FilterUbb(byval strHTML)
	Dim objRegExp, strOutput
	Set objRegExp = New Regexp	  
	strOutput=strHTML	
	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern="(\[EMOT\])(.[^\[]*)(\[\/EMOT\])"
	strOutput = objRegExp.Replace(strOutput, "")	
	objRegExp.Pattern =  "\[[^\]]*\]"
	strOutput = objRegExp.Replace(strOutput, " ")	
	FilterUbb = strOutput   
	Set objRegExp = Nothing
End Function


Sub passmessage()
	Dim iState
	iState=request("iState")
    If id = "" Then
        oblog.adderrstr ("错误：请指定要审核的留言！")
        oblog.showusererr
        Exit Sub
    End If
    If InStr(id, ",") > 0 Then
        Dim n, i
        id = FilterIDs(id)
        n = Split(id, ",")
        For i = 0 To UBound(n)
            passonemessage n(i),iState
        Next
    Else
        passonemessage id,iState
    End If
    Set rs = Nothing
    oblog.showok "审核留言成功!", ""
End Sub

Sub passonemessage(id,iState)
    id = Int(id)
	iState= CLng(iState)
    Dim userid
	Dim sScore
	If iState = 1 Then
		sScore=oblog.CacheScores(5)
	Else 
		sScore=-1*Abs(oblog.CacheScores(5))
	End if
    sql = "select * from [oblog_message] where messageid=" & Int(id) & " and userid=" & oblog.l_uId
    Set rs = server.CreateObject("adodb.recordset")
    rs.open sql, conn, 1, 3
    If Not rs.EOF Then
        userid = rs("userid")
		If rs("iState")<>iState Then
			If oblog.CacheConfig(50) = 0 Then 
				oblog.GiveScore "",sScore,""
			End If
		Else 
			Exit Sub
		End if
        rs("iState")=iState
        rs.Update
        rs.Close
        Set blog = New class_blog
        blog.userid = userid
        'blog.update_message 0,0,0,""
        blog.Update_message 0
        blog.Update_newmessage userid
        Set blog = Nothing
    Else
        rs.Close
        Set rs = Nothing
        oblog.adderrstr ("错误：无操作权限！")
        oblog.showusererr
        Exit Sub
    End If
End Sub
%>