syscode.asp

博客模块：Blog是继Email、BBS、ICQ后的第四种网络交流方式

<%
dim rsmain
dim show_userlogin,show_reg
dim show_class,show_bloger,show_userlist,show_sysxml,show_search,show_placard,show_friends,show_count
dim show_log,show_blogupdate,show_subject,show_comment,show_list
dim show_newblogger,show_bestblog
dim MaxPerPage
dim strFileName
dim totalPut,CurrentPage,TotalPages
response.Write  "<meta name='generator' content='"&sitetitle&"'>"& vbcrlf
response.Write "<link rel='alternate' href='rss2.asp' type='application/rss+xml' title='RSS' >"
response.Write "<title>"&sitetitle&"</title>"& vbcrlf
response.Write "</head>"& vbcrlf

sub ShowUserLogin()
	if CheckUserLogined()=False then
		dim regurl,gpurl
		if ot_user then 
			regurl="<a href='"&ot_regurl&"' target='_blank'>"
			gpurl="<a href='"&ot_lostpasswordurl&"' target='_blank'>"
		else
			regurl="<a href='user_reg.asp'>"
			gpurl="<a href='user_getpassword.asp'>"
		end if
    	show_userlogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
		show_userlogin=show_userlogin &  "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
        show_userlogin=show_userlogin & "<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_userlogin=show_userlogin & "<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_userlogin=show_userlogin & "<tr><td height='25' align='right'>Cookie：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbcrlf
		show_userlogin=show_userlogin & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td></tr>" & vbcrlf
		show_userlogin=show_userlogin & "<tr align='center'><td height='30' colspan='2'><input name='Login' type='submit' id='Login' value=' 登录 '> " & vbcrlf
        show_userlogin=show_userlogin & regurl&"用户注册</a>&nbsp;&nbsp;"&gpurl&"忘记密码</a><br></td>" & vbcrlf      
        show_userlogin=show_userlogin & "</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_userlogin="<div align='center'>--欢迎您," & UserName & "--</div>"
		show_userlogin= show_userlogin&"<div align='center'>您的身份："
		if UserLevel=7 then
			show_userlogin= show_userlogin&"注册用户"
		elseif UserLevel=8 then
			show_userlogin= show_userlogin&"VIP用户"
		elseif UserLevel=9 then
			show_userlogin= show_userlogin& "前台管理员"
		end if
		'show_userlogin= show_userlogin& "<br><b>用户控制面板：</b><br>" & vbcrlf
		show_userlogin= show_userlogin& "</div><div align='center'><a href=blog.asp?name="&username&" target='_blank'>我的blog</a>" & vbcrlf
		show_userlogin= show_userlogin& "&nbsp;&nbsp;<a href=user_index.asp target='_blank'>管理中心</a></div>" & vbcrlf
		show_userlogin= show_userlogin& "<div align='center'><a href='User_Logout.asp'>--注销登录--</a></div>" & vbcrlf
	end if
end sub

sub indexshow()
if instr(show,"$show_placard$")>0 then
	call sub_showplacard()
	show=replace(show,"$show_placard$",show_placard)
end if

if instr(show,"$show_class$")>0 then
	call sub_showclass()
	show=replace(show,"$show_class$",show_class)
end if

if instr(show,"$show_search$")>0 then
	call sub_showsearch()
	show=replace(show,"$show_search$",show_search)
end if

if instr(show,"$show_friends$")>0 then
call sub_showfriends()
show=replace(show,"$show_friends$",show_friends)
end if

if instr(show,"$show_count$")>0 then
	call sub_showcount()
	show=replace(show,"$show_count$",show_count)
end if

if instr(show,"$show_xml$")>0 then
	call sub_showsysxml()
	show=replace(show,"$show_xml$",show_sysxml)
end if
call runsub("$show_newblogger")
call runsub("$show_comment")
call runsub("$show_newblog")
call runsub("$show_subject")
call runsub("$show_blogupdate")
call runsub("$show_bestblog")
call runsub("$show_bloger")
call runsub("$show_log")
end sub

sub sysshow()
if Application(cachename&"list_update")=false and application(cachename&"list")<>"" then
	show=application(cachename&"list")
else
	dim rstmp
	set rstmp=conn.execute("select skinshowlog from sysskin where isdefault='true'")
	show=rstmp(0)
	set rstmp=nothing
	call indexshow
	Application.Lock
	application(cachename&"list_update")=false
	application(cachename&"list")=show
	Application.unLock
end if
if instr(show,"$show_userlogin$")>0 then
	call showuserlogin()
	show=replace(show,"$show_userlogin$",show_userlogin)
end if
end sub

sub runsub(label)
	dim tmp1,tmp2,i
	dim tmpstr,para
	tmp2=1
	while instr(tmp2,show,label)>0
		tmp1=instr(tmp2,show,label)
		tmp2=instr(tmp1+1,show,"$")
		tmpstr=mid(show,tmp1,tmp2-tmp1)
		tmpstr=replace(tmpstr,"(","")
		tmpstr=replace(tmpstr,")","")
		tmpstr=trim(replace(tmpstr,label,""))
		para=split(tmpstr,",")
		
		select case label
		case "$show_log"
			call sub_showlog(para(0),para(1),para(2),para(3),para(4),para(5),para(6),para(7),para(8))
			show=replace(show,label&"("&tmpstr&")$",show_log)
		case "$show_comment"
			call sub_showcomment(para(0),para(1))
			show=replace(show,label&"("&tmpstr&")$",show_comment)
		case "$show_newblog"
			call sub_shownewblog(para(0),para(1))
			show=replace(show,label&"("&tmpstr&")$",show_newblog)
		case "$show_subject"
			call sub_showsubject(para(0))
			show=replace(show,label&"("&tmpstr&")$",show_subject)
		case "$show_blogupdate"
			call sub_showblogupdate(para(0))
			show=replace(show,label&"("&tmpstr&")$",show_blogupdate)
		case "$show_newblogger"
			call sub_shownewblogger(para(0))
			show=replace(show,label&"("&tmpstr&")$",show_newblogger)
		case "$show_bestblog"
			call sub_showbestblog(para(0))
			show=replace(show,label&"("&tmpstr&")$",show_bestblog)
		case "$show_bloger"
			call sub_showbloger(para(0))
			show=replace(show,label&"("&tmpstr&")$",show_bloger)
		end select
	wend
end sub

sub sub_showlog(n,l,order,action,sdate,classid,classname,subjectname,info)
	show_log=""
	dim rs,msql,ordersql,actionsql,classsql
	dim rstmp,i
	dim postname,posttime,userurl
	i=0
	select case order
	case 1
		ordersql=" order by id desc"
	case 2
		ordersql=" order by iis desc"
	case 3
		ordersql=" order by commentnum desc"
	end select
	
	select case action
	case 1
		actionsql=""
	case 2
		actionsql=" and isbest='true'"
	end select
	
	if classid=0 then
		classsql=""
	else
		classsql=" and classid="&clng(classid)
	end if

	msql="select top "&n&" topic,username,addtime,commentnum,iis,id,classid,subjectid,author from blog"
	if issqldate then
		msql=msql&" where datediff(d,addtime,getdate())<"&cint(sdate)
		msql=msql&" and ishide<>'true' and passcheck<>'false' and (isnull(blog_password,'true')='true' or blog_password='')"
	else
		msql=msql&" where datediff('d',addtime,now())<"&cint(sdate)
		msql=msql&" and ishide<>'true' and passcheck<>'false' and (isnull(blog_password)=true or blog_password='')"
	end if	
	msql=msql&actionsql&classsql
	msql=msql&ordersql
	'response.Write(msql&"<br><br><br>")
	set rs=conn.execute(msql)
	show_log=show_log&"<ul>"
	do while not rs.eof
		show_log=show_log&"<li>"
		if rs(8)="" or isnull(rs(8)) then postname=rs(1) else postname=rs(8)
		posttime=rs(2)
		if classname=1 then
			set rstmp=conn.execute("select id,classname from classname where id="&rs(6))
			if not rstmp.eof then
				show_log=show_log&"<a href=list.asp?classid="&rstmp(0)&" target=_blank>〖"&rstmp(1)&"〗</a>"
			end if
			set rstmp=nothing
		end if
		if subjectname=1 then
			set rstmp=conn.execute("select id,subjectname from subject where id="&rs(7))
			if not rstmp.eof then
				show_log=show_log&"<a href=blog.asp?name="&rs(1)&"&subjectid="&rstmp(0)&" target=_blank>["&rstmp(1)&"]</a>"
			end if
			set rstmp=nothing		
		end if
		dim topic
		if rs(0)<>"" then
			topic=replace(rs(0),"'","")
			if strLength(topic)>int(l) then
				topic=InterceptString(topic,l-3)&"..."
			end if
		end if
		show_log=show_log&"<a href=more.asp?name="&rs(1)&"&id="&rs(5)&" title="&htmlencode(topic)&" target=_blank>"&htmlencode(topic)&"</a>"
		if Application(cachename&"info")(32)="true" then
			userurl="http://"&trim(rs(1))&"."&trim(Application(cachename&"info")(6))
		else
			userurl="blog.asp?name="&trim(rs(1))
		end if
		select case cint(info)
		case 1
			show_log=show_log&"(<a href="&userurl&" target=_blank>"&postname&"</a>,"&formatdatetime(posttime,0)&")"
		case 2
			show_log=show_log&"("&posttime&")"
		case 3
			show_log=show_log&"(<a href="&userurl&" target=_blank>"&postname&"</a>)"
		case 4
			show_log=show_log&"(<a href="&userurl&" target=_blank>"&postname&"</a>,"&rs(4)&")"
		case 5
			show_log=show_log&"("&rs(4)&")"
		case 6
			show_log=show_log&"(<a href="&userurl&" target=_blank>"&postname&"</a>,"&formatdatetime(posttime,1)&")"
		case 7
			show_log=show_log&"("&formatdatetime(posttime,1)&")"
		case 8
			show_log=show_log&"("&rs(3)&")"
		case else
		end select
		show_log=show_log&vbcrlf
		rs.movenext
		i=i+1
		if i>=int(n) then  exit do
	loop
	show_log=show_log&"</li></ul>"
	set rs=nothing	
end sub

sub sub_showclass()
	dim rs
	'show_class="<a href=index.asp>首页("&blogcount&")</a><br>"
	set rs=conn.execute("select id,classname,classlognum from classname order by ordernum asc")
	while not rs.eof 
		show_class=show_class&"<a href=list.asp?classid="&rs(0)&">"&rs(1)&"("&rs(2)&")</a><br>"
		rs.movenext
	wend
	set rs=nothing
end sub

sub sub_showcomment(n,l)
	dim rs
	set rs=conn.execute("select top "&n&" mainid,mainuser,commenttopic,comment_user,addtime from [comment] order by id desc")
	while not rs.eof 
		show_comment=show_comment&"<a href=more.asp?name="&rs(1)&"&id="&rs(0)&" target=_blank title="&rs(3)&"回复于"&rs(4)&">"&left(htmlencode(rs(2)),l)&"</a><br>"
		rs.movenext
	wend
	set rs=nothing
end sub

sub sub_showsubject(n)
	dim i,rs
	i=0
	set rs=conn.execute("select top "&n&" id,username,subjectname,subjectlognum from [subject] order by subjectlognum desc")
	do while not rs.eof
		'show_subject="<a href="&indexurl&">首页</a><br>"
		show_subject=show_subject&"<a href='blog.asp?subjectid="&rs(0)&"&name="&rs(1)&"' target='_blank'>"&htmlencode(rs(2))&"("&rs(3)&")</a><br>"
		rs.movenext
		i=i+1
		if i>=int(n) then  exit do
	loop
	set rs=nothing
end sub

sub sub_showblogupdate(n)
	dim i,rs,userurl
	i=0
	set rs=conn.execute("select top "&n&" username,logcount,blogname from [user] where lockuser='false' order by logcount desc")
	do while not rs.eof 
		if Application(cachename&"info")(32)="true" then
			userurl="http://"&trim(rs(0))&"."&trim(Application(cachename&"info")(6))
		else
			userurl="blog.asp?name="&trim(rs(0))
		end if		
		if rs(2)<>"" then
			show_blogupdate=show_blogupdate&"<a href="&userurl&" target=_blank>"&rs(2)&"("&rs(1)&")</a><br>"
		else
			show_blogupdate=show_blogupdate&"<a href="&userurl&" target=_blank>"&rs(0)&"("&rs(1)&")</a><br>"
		end if
		rs.movenext	
		i=i+1
		if i>=int(n) then  exit do
	loop
	set rs=nothing
end sub

sub sub_shownewblogger(n)
	dim rs,userurl
	set rs=conn.execute("select top "&n&" username,logcount,nickname from [user] where lockuser='false'  order by userid desc")
	while not rs.eof 
		if Application(cachename&"info")(32)="true" then
			userurl="http://"&trim(rs(0))&"."&trim(Application(cachename&"info")(6))
		else
			userurl="blog.asp?name="&trim(rs(0))
		end if		
		if rs(2)<>"" then
			show_newblogger=show_newblogger&"<a href="&userurl&" target=_blank>"&rs(2)&"("&rs(1)&")</a><br>"
		else
			show_newblogger=show_newblogger&"<a href="&userurl&" target=_blank>"&rs(0)&"("&rs(1)&")</a><br>"
		end if
		rs.movenext	
	wend
	set rs=nothing
end sub

sub sub_showbestblog(n)
	dim i,rs,userurl
	i=0
	set rs=conn.execute("select top "&n&" username,logcount,nickname from [user] where userisbest='true' order by logcount desc")
	do while not rs.eof 
		if Application(cachename&"info")(32)="true" then
			userurl="http://"&trim(rs(0))&"."&trim(Application(cachename&"info")(6))
		else
			userurl="blog.asp?name="&trim(rs(0))
		end if		
		if rs(2)<>"" then
			show_bestblog=show_bestblog&"<a href="&userurl&" target=_blank>"&rs(2)&"("&rs(1)&")</a><br>"
		else
			show_bestblog=show_bestblog&"<a href="&userurl&" target=_blank>"&rs(0)&"("&rs(1)&")</a><br>"
		end if
		rs.movenext	
		i=i+1
		if i>=int(n) then  exit do
	loop
	set rs=nothing
end sub

sub sub_showcount
	dim rs
	if issqldate then
		set rs=conn.execute("select count(id) from blog where datediff(d,addtime,getdate())=0")
	else
		set rs=conn.execute("select count(id) from blog where datediff('d',addtime,now())=0")
	end if
	show_count="博客："&sysusercount
	show_count=show_count&"<br>日志："&syslogcount
	show_count=show_count&"<br>评论："&syscommentcount
	show_count=show_count&"<br>留言："&sysmessagecount
	show_count=show_count&"<br>今日："&rs(0)
	set rs=nothing
end sub

sub sub_showsysxml()
	show_sysxml="<a href='rss2.asp' target='_blank'><img src='Images/xml.gif' width='36' height='14' border='0'></a>"
end sub

sub sub_showfriends
	if isnull(sitefriends) then
		show_friends=" "
	else
		show_friends=sitefriends
	end if
end sub

sub sub_showplacard
	if isnull(aApplicationValue(30)) then
		show_placard=" "
	else
		show_placard=aApplicationValue(30)
	end if
end sub

sub sub_showbloger(m)
	dim rs
	dim i,brstr
	m=int(m)
	set rs=conn.execute("select id,typename,usernum from usertype order by ordernum asc")
	if m=0 then
		while not rs.eof 
			show_bloger=show_bloger&"<a href=listblogger.asp?usertype="&rs(0)&">"&rs(1)&"</a><br>"
			rs.movenext
		wend
	else
		i=0
		while not rs.eof
			i=i+1
			if i=int(m) then
				brstr="<br>"
				i=0
			else
				brstr=""
			end if			
			show_bloger=show_bloger&"<a href=listblogger.asp?usertype="&rs(0)&">"&rs(1)&"</a> "&brstr
			rs.movenext
		wend
	end if
	set rs=nothing
end sub

sub sub_showsearch
	show_search="<form name='search' method='post' action='list.asp'>"
	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>"
	show_search=show_search&"<option value='id'>博客名称</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

%>