📄 showcode.asp
字号:
<%
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_showuserplacard
'作 用：
'参 数：where语句
'**************************************************
sub sub_showuserplacard()
if userplacard<>"" then
show_userplacard=userplacard
else
show_userplacard="暂无公告..."
end if
end sub
'**************************************************
'过程名：sub_showuselinks
'作 用： 显示用户连接
'参 数：where语句
'**************************************************
sub sub_showuserlinks()
show_userlinks=Application(cachename&"info")(28)
show_userlinks=show_userlinks&"<br>"&userlinks
if show_userlinks="" then show_userlinks=" "
end sub
'**************************************************
'过程名：sub_showuserinfo
'作 用： 显示用户blog信息
'参 数：where语句
'**************************************************
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
'**************************************************
'函数名：trimlog
'作 用：截取日志
'参 数：日志内容，显示字数
'**************************************************
function trimlog(logtext,showword)
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
'**************************************************
'作 用：显示用户专题排行
'参 数：where语句，显示条数
'**************************************************
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
'**************************************************
'作 用：显示最新回复
'参 数：where语句，显示条数
'**************************************************
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="&rs(3)&"回复于"&rs(4)&">"&left(rs(2),18)&"<a><br>"
rs.movenext
wend
end sub
'**************************************************
'作 用：显示最新文章标题
'参 数：where语句，显示条数
'**************************************************
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="&rs(1)&"发表于"&rs(3)&">"&left(rs(2),18)&"<a><br>"
rs.movenext
wend
end sub
'**************************************************
'作 用：显示用户xml
'参 数：无
'**************************************************
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
'**************************************************
'作 用：显示用户blog名
'参 数：无
'**************************************************
sub sub_showblogname()
if user_blogname<>"" then
show_blogname=user_blogname
else
show_blogname=show_username
end if
end sub
'**************************************************
'作 用：显示最新留言
'参 数：where语句，显示条数
'**************************************************
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
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="&rs(2)&"发表于"&rs(3)&">"&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
'==================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'==================================================
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& " <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' title='点击新窗口查看大图'>")
end if
if show_imgw_num>0 then
objRegExp.Pattern = "(<img[^>]*)>"
strOutput = objRegExp.Replace(strOutput, "$1 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
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -