user_blog.asp

oblog2.52商业sql版,稳定易用

	  while s<=59
	  	if second(rsblog("addtime"))=s then
		  	response.Write "<option value="&s&" selected>"&s&"</option>"
		else
		  	response.Write "<option value="&s&">"&s&"</option>"
		end if
		s=s+1
	  wend
		%>
        </select>
        秒 
        <input name="upfiles"  type="hidden" id="upfiles" > <input name="serverdate"  type="hidden" id="serverdate" value=<%=date()%> ></td>
    </tr>
    <tr> 
      <td height=23 colspan="5" class="tdbg"> <INPUT type="hidden" name="id" value="<%=rsblog("id")%>"> 
        <input type="submit" name="Submit2" value="提交修改">
        　　　　 
        <input type="reset" name="Submit" value="清除重写"> </td>
    </tr>
  </table> 
</form>
<%
	rsblog.close
	set rsblog=nothing
end sub

sub SaveModify()
	dim id,rsblogchk
	dim logtext
	dim i
	dim blogteam,blogteamsubject
	id=clng(trim(request("id")))
	blogteam=trim(request("blogteam"))
	blogteamsubject=clng(request("blogteamsubject"))

	'call chkenaddlog()
	if userlevel=9 then
		sql="select * from blog where id="&id
	else
		sql="select * from blog where id="&id&" and (username='"&username&"' or author='"&username&"')"
	end if	
	set rs=server.createobject("adodb.recordset")
	rs.open sql,conn,1,3
	rs("topic")=debadstr(trim(request("topic")))
	for i = 1 to Request.Form("logtext").Count 
  		logtext = logtext & Request.Form("logtext")(i)
	Next
	if logtext="" then
		logtext=trim(request.form("edit"))
	end if
	rs("logtext")=filtpath(debadstr(logtext))
	rs("face")=trim(request("face"))
	if userlevel<>9 then
		rs("username")=blogteam
	end if
	rs("addtime")=request("selecty")&"-"&request("selectm")&"-"&request("selectd")&" "&request("selecth")&":"&request("selectmi")&":"&request("selects")
	rs("classid")=clng(trim(request("classid")))
	if userlevel<>9 then
		if blogteamsubject<>0 then
			rs("subjectid")=blogteamsubject
		else
			rs("subjectid")=clng(trim(request("subjectid")))
		end if
	else
		rs("subjectid")=clng(trim(request("subjectid")))
	end if
	if request("showword")<>"" then
		rs("showword")=clng(trim(request("showword")))
	else
		rs("showword")=0
	end if
	rs("ishide")=trim(request("ishide"))
	if request("upfiles")<>"" then
		if rs("upfiles")<>"" then
			rs("upfiles")=rs("upfiles")&"|"&request("upfiles")
		else
			rs("upfiles")=request("upfiles")
		end if
	end if
	if trim(request("ispassword"))=rs("ispassword") then
	else
		if trim(request("ispassword"))<>"" then
			rs("ispassword")=md5(trim(request("ispassword")))
		else
			rs("ispassword")=""
		end if
	end if
	set rsblogchk=conn.execute("select blogcheck from bloginfo") '判断是否需要审核
	if rsblogchk("blogcheck")="true" then
		rs("passcheck")="false"
		set rsblogchk=nothing
	else
		if findbadstr(logtext) then '检查敏感字出现次数
			rs("passcheck")="false"
		else
			rs("passcheck")="true"
		end if		
	end if
	set rsblogchk=nothing
	rs.update
	rs.close
	set rs=nothing
	call CloseConn()
	Response.Write"<script language=JavaScript>"
	Response.Write"alert(""修改日志成功！"");"
	Response.Write"window.history.go(-2);"
	Response.Write"</script>"
	'response.redirect "User_blog.asp"
end sub


sub Delblog()
	dim rsfile
	set rsfile=conn.execute("select upfile_path from bloginfo")
	uppath=rsfile(0)
	set rsfile=nothing
	if ID="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请指定要删除的日志</li>"
		exit sub
	end if
	if instr(ID,",")>0 then
		ID=replace(ID," ","")
		if userlevel=9 then
			'set rsfile=conn.execute("select upfiles from blog where ID  in (" & ID & ")")
			'while not rsfile.eof
				'if rsfile(0)<>"" then					
					'deletefile(rsfile(0))
				'end if
			'rsfile.movenext
			'wend
			'set rsfile=nothing
			sql="delete from [blog] where ID  in (" & ID & ")"
		else
			'set rsfile=conn.execute("select upfiles from blog where ID  in (" & ID & ") and username='"&username&"'")
			'while not rsfile.eof
				'if rsfile(0)<>"" then					
					'deletefile(rsfile(0))
				'end if
			'rsfile.movenext
			'wend
			'set rsfile=nothing
			sql="delete from [blog] where ID  in (" & ID & ")"&" and (username='"&username&"' or author='"&username&"')"			
		end if
		conn.execute("delete from comment where mainid in (" & ID & ")")
		dim n,i,u '日志数-１
		n=split(id,",")
		u=split(uname,",")
		for i=0 to ubound(n)
			conn.execute("update [user] set logcount=logcount-1 where username='"&trim(u(i))&"'")
		next		
	else
		if userlevel=9 then
			'set rsfile=conn.execute("select upfiles from blog where ID=" & Clng(ID))
			'if rsfile(0)<>"" then					
				'deletefile(rsfile(0))
			'end if
			'set rsfile=nothing
			sql="delete from [blog] where ID=" & Clng(ID)

		else
			'set rsfile=conn.execute("select upfiles from blog where ID=" & Clng(ID)&" and username='"&username&"'")
			'if rsfile(0)<>"" then					
				'deletefile(rsfile(0))
			'end if
			'set rsfile=nothing
			sql="delete from [blog] where ID=" & Clng(ID)&" and (username='"&username&"' or author='"&username&"')"
			conn.execute("update [user] set logcount=logcount-1 where username='"&username&"'")
		end if
		conn.execute("delete from comment where mainid="& Clng(ID))		
	end if
	Conn.Execute sql
	call CloseConn()      
	response.redirect ComeUrl
end sub

sub Lockblog()
	if userlevel<>9 then
		exit sub
	end if
	if ID="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请选择要设为未审核的日志</li>"
		exit sub
	end if
	if instr(ID,",")>0 then
		ID=replace(ID," ","")
			sql="Update [blog] set passcheck ='false' where ID  in (" & ID & ")"
	else
			sql="Update [blog] set passcheck='false' where ID =" & CLng(ID)
	end if
	Conn.Execute sql
	call CloseConn()      
	response.Redirect "User_blog.asp"
end sub

sub passblog()
	if userlevel<>9 then
		exit sub
	end if
	if ID="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请指定要通过审核的日志</li>"
		exit sub
	end if
	if instr(ID,",")>0 then
		ID=replace(ID," ","")
		sql="Update [blog] set passcheck='true' where ID in (" &ID& ")"
	else
		sql="Update [blog] set passcheck='true' where ID=" & CLng(ID)
	end if
	Conn.Execute sql
	call CloseConn()      
	response.Redirect "User_blog.asp"
end sub

sub isbest()
	if userlevel<>9 then
		exit sub
	end if
	if ID="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请选择要推荐日志</li>"
		exit sub
	end if
	if instr(ID,",")>0 then
		ID=replace(ID," ","")
		sql="Update [blog] set isbest ='true' where ID  in (" & ID & ")"
	else
		sql="Update [blog] set isbest='true' where ID =" & CLng(ID)
	end if
	Conn.Execute sql
	call CloseConn()      
	response.Redirect "user_blog.asp"
end sub

sub moveblog()
	if id="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>请选择要移动的日志</li>"
		exit sub
	end if
	dim subjectid
	subjectid=trim(request("subject"))
	if subjectid="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>请指定目标专题</li>"
		exit sub
	else
		subjectid=Clng(subjectid)
	end if
	if instr(id,",")>0 then
		id=replace(id," ","")
		sql="Update [blog] set subjectid="&subjectid&" where id in (" & id & ")"
	else
		sql="Update [blog] set subjectid="&subjectid&" where id=" & id 
	end if
	Conn.Execute sql
	response.Redirect "user_blog.asp"
end sub

sub unisbest()
	if userlevel<>9 then
		exit sub
	end if
	if ID="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请选择要取消推荐日志</li>"
		exit sub
	end if
	if instr(ID,",")>0 then
		ID=replace(ID," ","")
		sql="Update [blog] set isbest ='false' where ID  in (" & ID & ")"
	else
		sql="Update [blog] set isbest='false' where ID =" & CLng(ID)
	end if
	Conn.Execute sql
	call CloseConn()      
	response.Redirect "User_blog.asp"
end sub

sub WriteErrMsg()
	dim strErr
	strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
	strErr=strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='tdbg'><td><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	strErr=strErr & "</body></html>" & vbcrlf
	response.write strErr
end sub

function DeleteFile(Filename) '删除文件 
	dim fso,delname,i,rs
	if Filename<>"" then 
		Set fso = server.CreateObject("Scripting.FileSystemObject")
		if instr(filename,"|")<>0 then
			delname=split(filename,"|")
			for i=0 to ubound(delname)			
				if fso.FileExists(Server.MapPath(uppath&"/"&delname(i))) then 
					fso.DeleteFile Server.MapPath(uppath&"/"&delname(i))
				end if 
			next
		else
			if fso.FileExists(Server.MapPath(uppath&"/"&filename)) then 
				fso.DeleteFile Server.MapPath(uppath&"/"&filename)
			end if 	
		end if
	set fso = nothing 
	end if 
end function 

sub getteam()
dim s,i,s1,rs,rs1
set rs=server.createobject("adodb.recordset")
rs.open "select blogteam.mainuser,[user].blogname from blogteam,[user] where blogteam.otheruser='"&username&"' and blogteam.mainuser=[user].username",conn,1,1
if not rs.eof then
	response.write "<script language=""JavaScript"">"&vbcrlf
	s = "var p_array = new Array(" + cstr(rs.recordcount-1) + ");"&vbcrlf
	response.write s
	s = "var p_array_id = new Array(" + cstr(rs.recordcount-1) + ");"&vbcrlf
	response.write s
	i = 0
	while not rs.eof
		set rs1=server.createobject("adodb.recordset")
		rs1.open "select id,subjectname from subject where username='"&rs("mainuser")&"'",conn,1,1
 		s = "var p"+cstr(rs("mainuser"))+"_array = Array("
 		s1 = "var p"+cstr(rs("mainuser"))+"_array_id = Array("
  		if rs1.recordcount > 0 then
 		while not rs1.eof
  			if trim(rs1("subjectname"))<>"" then
   				s = s + """" + htmlencode(rs1("subjectname")) + """" 
   				s1 = s1 + """" + cstr(rs1("id")) + """"
				s = s + ","
   				s1 = s1 + ","
 			end if
 		 	rs1.movenext
		wend
		s = s + """" + "不选择专题" + """" 
		s1 = s1 + """" + cstr(0) + """"
		else
   			s = s + """" + "无可用专题" + """" 
   			s1 = s1 + """" + cstr(0) + """"
 		end if
 		s = s+ ");"&vbcrlf
 		s1 = s1+ ");"&vbcrlf
 		response.write s
 		response.write s1 
		response.write "p_array["+cstr(i)+"] = p"+cstr(rs("mainuser"))+"_array;"&vbcrlf
		response.write "p_array_id["+cstr(i)+"] = p"+cstr(rs("mainuser"))+"_array_id;"&vbcrlf
		i = i + 1
		rs.movenext
	wend
	response.write  "</script>"&vbcrlf
	rs.close
	set rs=nothing
	rs1.close
	set rs1=nothing
end if
end sub

function filtpath(str)
	dim nurl
	nUrl=trim("http://" & Request.ServerVariables("SERVER_NAME"))
	nUrl=nUrl & request.ServerVariables("SCRIPT_NAME")
	nurl=left(nUrl,instrrev(nUrl,"/"))
	filtpath=replace(str,nurl,"")
end function

%>