<%
dim show_log,show_blogupdate,show_logmore,show_comment
dim show_newblog,show_message,show_newmessage,show_userxml
dim show_userplacard,show_userlinks,show_userinfo
dim show_blogname,show_subject_l,show_subject,show_search
dim show_login

sub usershow()
	call calendar()
	show=replace(show,"$show_calendar$",ccode)

	call sub_showuserplacard()
	show=replace(show,"$show_placard$",show_userplacard)

	call sub_showuserlinks()
	show=replace(show,"$show_links$",show_userlinks)

	call sub_user_showsubject()
	show=replace(show,"$show_subject$",show_subject)
	show=replace(show,"$show_subject_l$",show_subject_l)

	call sub_showcomment(user_shownewcomment_num)
	show=replace(show,"$show_comment$",show_comment)

	call sub_shownewblog(user_shownewlog_num)
	show=replace(show,"$show_newblog$",show_newblog)

	call sub_shownewmessage(user_shownewmessage_num)
	show=replace(show,"$show_newmessage$",show_newmessage)

	call sub_showuserinfo()
	show=replace(show,"$show_info$",show_userinfo)

	call sub_showuserxml()
	show=replace(show,"$show_xml$",show_userxml)

	call showuserlogin()
	show=replace(show,"$show_login$",show_login)

	call sub_showblogname()
	show=replace(show,"$show_blogname$",show_blogname)
	
	call sub_usershowsearch()
	show=replace(show,"$show_search$",show_search)
	
end sub

sub sub_showuserplacard()
	if userplacard<>"" then
		show_userplacard=userplacard
	else
		show_userplacard="暂无公告..."
	end if
end sub

sub sub_showuserlinks()
	show_userlinks=Application(cachename&"info")(28)
	show_userlinks=show_userlinks&"<br>"&userlinks
	if show_userlinks="" then show_userlinks=" "
end sub

sub sub_showuserinfo()
	show_userinfo="blog名称:"&user_blogname
	show_userinfo=show_userinfo&"<br>日志总数:"&user_logcount
	show_userinfo=show_userinfo&"<br>评论数量:"&user_commentcount
	show_userinfo=show_userinfo&"<br>留言数量:"&user_messagecount
	show_userinfo=show_userinfo&"<br>访问次数:"&user_siterefu_num
	show_userinfo=show_userinfo&"<br>建立时间:"&user_adddate
end sub

function trimlog(logtext,showword)
	ON ERROR RESUME NEXT
	dim Contentlen
	'if showwordnum<>0 then 
	'	if showword>showwordnum or showword=0 then
	'		showword=showwordnum
	'	end if
	'end if
	ContentLen=strLength(logtext)
	if ContentLen<=showword or showword=0 then
		trimlog=logtext
	else	
	'trimlog=dehtm(left(logtext,showword))	
		if Instrrev(logtext,"<object") > 0 or Instrrev(logtext,"<OBJECT") > 0 then
			if showword<100 then
				trimlog=""
			else
				trimlog=detable(logtext)
			end if
		else
			trimlog=InterceptString(detable(logtext),showword+100)
				If Instrrev(trimlog,"<P",-1,1) > 0 and (Len(trimlog) - Instrrev(trimlog,"<P",-1,1))< 400 then
					trimlog = Left(trimlog,InstrRev(trimlog,"<P",-1,1)-1)
				elseif Instrrev(trimlog,"<img",1) > 0 and (Len(trimlog) - Instrrev(trimlog,"<img",1))< 400 then
					trimlog = Left(trimlog,InstrRev(trimlog,"<img",1)-1)
				elseIf Instrrev(trimlog,"。") > 0 and (Len(trimlog) - Instrrev(trimlog,"。"))< 400 then
					trimlog = Left(trimlog,InstrRev(trimlog,"。"))
				elseIf Instrrev(trimlog,"<br",1) > 0 and (Len(trimlog) - Instrrev(trimlog,"<br",1))< 400 then
					trimlog = Left(trimlog,InstrRev(trimlog,"<br",0,1)-1)
				'elseif Instrrev(trimlog,"<object",-1,1) > 0 and (Len(trimlog) - Instrrev(trimlog,"<object",-1,1))< 200 then
				'	trimlog = Left(trimlog,InstrRev(trimlog,"<object",-1,1)-1)
				elseif Instrrev(trimlog,"?") > 0 and (Len(trimlog) - Instrrev(trimlog,"?"))< 400 then
					trimlog = Left(trimlog,InstrRev(trimlog,"?"))
				end if				
		end if	
	'if instr(1,trimlog,"<object",1)<>0 then	trimlog=left(detable(logtext),instr(1,detable(logtext),"</object>",1)+9-1)
	trimlog=trimlog&"<br>……"
	end if
end function

sub sub_user_showsubject()
	if issqldate then
		dim cmd
		set cmd = Server.CreateObject("ADODB.Command")
		Set cmd.ActiveConnection=conn
		cmd.CommandType=4
		cmd.CommandText="ob_user_showsubject"
		cmd("@show_username")=show_username
		set rs=cmd.Execute
		set cmd=nothing
	else
		set rs=conn.execute("select id,username,subjectname,subjectlognum from [subject] where username='"&show_username&"' order by ordernum asc")
	end if
	show_subject="<a href='blog.asp?name="&show_username&"'>首页("&user_logcount&")</a><br>"
	show_subject_l="<a href='blog.asp?name="&show_username&"'>首页("&user_logcount&")</a>　"
	while not rs.eof 
		show_subject=show_subject&"<a href=blog.asp?subjectid="&rs(0)&"&name="&rs(1)&">"&rs(2)&"("&rs(3)&")<a><br>"
		show_subject_l=show_subject_l&"<a href=blog.asp?subjectid="&rs(0)&"&name="&rs(1)&">"&rs(2)&"("&rs(3)&")<a>　"
		rs.movenext
	wend
end sub

sub sub_showcomment(n)
	if issqldate then
		dim cmd
		set cmd = Server.CreateObject("ADODB.Command")
		Set cmd.ActiveConnection=conn
		cmd.CommandType=4
		cmd.CommandText="ob_user_showcomment"
		cmd("@show_username")=show_username
		cmd("@n")=n
		set rs=cmd.Execute
		set cmd=nothing
	else
		set rs=conn.execute("select top "&n&" mainid,mainuser,commenttopic,comment_user,addtime,id from [comment] where mainuser='"&show_username&"' order by id desc")
	end if
	while not rs.eof 
		show_comment=show_comment&"<a href=more.asp?name="&rs(1)&"&id="&rs(0)&"#"&rs(5)&" title="&htmlencode(rs(3))&"发表评论于"&rs(4)&">"&htmlencode(left(rs(2),20))&"<a><br>"
		rs.movenext
	wend
end sub

sub sub_shownewblog(n)
	if issqldate then
		dim cmd
		set cmd = Server.CreateObject("ADODB.Command")
		Set cmd.ActiveConnection=conn
		cmd.CommandType=4
		cmd.CommandText="ob_user_shownewblog"
		cmd("@show_username")=show_username
		cmd("@n")=n
		set rs=cmd.Execute
		set cmd=nothing
	else
		set rs=conn.execute("select top "&n&" id,username,topic,addtime from [blog] where username='"&show_username&"' and ishide<>'true' and passcheck<>'false' order by addtime desc")
	end if
	while not rs.eof 
		show_newblog=show_newblog&"<a href=more.asp?name="&rs(1)&"&id="&rs(0)&" title="&htmlencode(rs(1))&"发表于"&rs(3)&">"&htmlencode(left(rs(2),18))&"<a><br>"
		rs.movenext
	wend
end sub

sub sub_showuserxml()
	show_userxml="<a href='rss2.asp?name="&show_username&"' target='_blank'><img src='Images/xml.gif' width='36' height='14' border='0'></a>"
end sub

sub sub_showblogname()
	if user_blogname<>"" then
		show_blogname=user_blogname
	else
		show_blogname=show_username
	end if 
end sub

sub sub_shownewmessage(n)
	if issqldate then
		dim cmd
		set cmd = Server.CreateObject("ADODB.Command")
		Set cmd.ActiveConnection=conn
		cmd.CommandType=4
		cmd.CommandText="ob_user_shownewmessage"
		cmd("@show_username")=show_username
		cmd("@n")=n
		set rs=cmd.Execute
		set cmd=nothing
	else
		set rs=conn.execute("select top "&n&" mainuser,messagetopic,message_user,addtime,id from [message] where mainuser='"&show_username&"' order by id desc")
	end if
	show_newmessage="<a href='message.asp?name="&show_username&"#message'>签写新留言</a><br><br>"
	if not (rs.eof or rs.bof) then
		while not rs.eof 
			show_newmessage=show_newmessage&"<a href=message.asp?name="&rs(0)&"#"&rs(4)&" title="&htmlencode(rs(2))&"发表于"&rs(3)&">"&htmlencode(left(rs(1),20))&"<a><br>"
			rs.movenext
		wend
	else
	'show_newmessage="<a href=message.asp?name="&show_username&">点击此处进入留言板。</a>"
	end if
end sub

sub sub_usershowsearch
	show_search="<form name='search' method='post' action='blog.asp?name="&show_username&"'>"
	show_search=show_search&"<select name='selecttype' id='selecttype'>"
	show_search=show_search&"<option value='topic' selected>日志标题</option>"
	show_search=show_search&"<option value='logtext'>日志内容</option></select><br>"
	show_search=show_search&"<input name='keyword' type='text' id='keyword' size='16' maxlength='40'>"
	show_search=show_search&" <input type='submit' name='Submit' value='搜索'></form>"
end sub

sub ShowUserLogin()
		if CheckUserLogined()=False then
    	show_login="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
		show_login=show_login &  "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
        show_login=show_login & "<tr><td height='25' align='right'>用户名称：</td><td height='25'><input name='UserName' type='text' id='UserName' size='15' maxlength='20'></td></tr>" & vbcrlf
        show_login=show_login & "<tr><td height='25' align='right'>登陆密码：</td><td height='25'><input name='Password' type='password' id='Password' size='15' maxlength='20'></td></tr>" & vbcrlf
        show_login=show_login & "<tr><td height='25' align='right'>密码保存：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbcrlf
		show_login=show_login & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td></tr>" & vbcrlf
		show_login=show_login & "<tr align='center'><td height='30' ><input name='Login' type='submit' id='Login' value=' 登录 '> </td><td></td>" & vbcrlf
        show_login=show_login & "</td>" & vbcrlf      
        show_login=show_login & "</tr></form></table>" & vbcrlf
		%>
<script language=javascript>
	function CheckForm()
	{
		if(document.UserLogin.UserName.value=="")
		{
			alert("请输入用户名！");
			document.UserLogin.UserName.focus();
			return false;
		}
		if(document.UserLogin.Password.value == "")
		{
			alert("请输入密码！");
			document.UserLogin.Password.focus();
			return false;
		}
	}
	
</script>
<%
	Else 
		show_login="<div align='center'>--欢迎您," & UserName & "--</div>"
		show_login= show_login&"<div align='center'>您的身份："
		if UserLevel=7 then
			show_login= show_login&"注册用户"
		elseif UserLevel=8 then
			show_login= show_login&"VIP用户"
		elseif UserLevel=9 then
			show_login= show_login& "前台管理员"
		end if
		'show_login= show_login& "<br><b>用户控制面板：</b><br>" & vbcrlf
		show_login= show_login& "</div><div align='center'><a href=blog.asp?name="&username&" target='_blank'>我的blog</a>" & vbcrlf
		show_login= show_login& "&nbsp;&nbsp;<a href=User_index.asp target='_blank'>管理中心</a></div>" & vbcrlf
		show_login= show_login& "<div align='center'><a href='User_Logout.asp'>--注销登录--</a></div>" & vbcrlf
	end if
end sub

Function detable(strHTML)
  Dim objRegExp, strOutput
  Set objRegExp = New Regexp
  
  strOutput=strHTML

  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  objRegExp.Pattern = "</?table[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")
  
  objRegExp.Pattern = "</?tr[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")
  
  objRegExp.Pattern = "</?td[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")
  
  objRegExp.Pattern = "</?th[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")

  objRegExp.Pattern = "</?BLOCKQUOTE[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")
  
  objRegExp.Pattern = "</?tbody[^>]*>"
  strOutput = objRegExp.Replace(strOutput, "")
  
  objRegExp.Pattern = "<style[^\s]*"
  strOutput = objRegExp.Replace(strOutput, "")
  
    detable = strOutput   
  Set objRegExp = Nothing
End Function

function profilthtm(strHTML)
	Dim objRegExp, strOutput
	Set objRegExp = New Regexp  
	strOutput=strHTML
	objRegExp.IgnoreCase = True
	objRegExp.Global = True

	objRegExp.Pattern = "<img"
	strOutput = objRegExp.Replace(strOutput,"♂")
	
	objRegExp.Pattern = "(♂[^>]*)>"
	strOutput = objRegExp.Replace(strOutput,"$1♀")
	
	objRegExp.Pattern = "<[^>]*>"
	strOutput = objRegExp.Replace(strOutput,"")
	
	objRegExp.Pattern = "style[^\s]*"
	strOutput = objRegExp.Replace(strOutput, "")
	
	objRegExp.Pattern = "♂"
	strOutput = objRegExp.Replace(strOutput,"<img")
	
	objRegExp.Pattern = "♀"
	strOutput = objRegExp.Replace(strOutput,">")
	
	profilthtm = strOutput   
	Set objRegExp = Nothing
end function

Function filtimg(strHTML)
  Dim objRegExp, strOutput
  Set objRegExp = New Regexp
  
  strOutput=strHTML

  objRegExp.IgnoreCase = True
  objRegExp.Global = True

  if show_img_mouse="true" then
  	Response.Write "<script src=""inc/main.js"" type=""text/javascript""></script>"
	objRegExp.Pattern = "(<img[^>]*)>"
	strOutput = objRegExp.Replace(strOutput, "$1 onmousewheel='return bbimg(this)' border='0' >")
  end if
   
  if show_imgw_num>0 then
   	objRegExp.Pattern = "(<[^>]*src=\x22([^ ]*)\x22[^>]*>)"
	strOutput = objRegExp.Replace(strOutput, "<a href=$2 target=_blank>$1</a>")

	objRegExp.Pattern = "(<img[^>]*)>"
	strOutput = objRegExp.Replace(strOutput, "$1 border='0' title='点击在新窗口查看原始图片' onload='java_script_:if(this.width>"&show_imgw_num&")this.width="&show_imgw_num&"'>")
  end if
 
  filtimg = strOutput   
  Set objRegExp = Nothing
End Function

Function filtscript(strHTML)
  Dim objRegExp, strOutput
  Set objRegExp = New Regexp  
  strOutput=strHTML
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  objRegExp.Pattern = "<script[^>]*>(.|\n)*<\/script>"
  strOutput = objRegExp.Replace(strOutput, "")
  strOutput = replace(strOutput, "javascript:", "javascript :")
   filtscript = strOutput   
  Set objRegExp = Nothing
End Function

%>