syscode_joke.asp

后台登陆admin.asp

end if
hx01.movenext
loop
hx01.close
set hx01=nothing
if cat_id>0 then
   sql="select * from joke where passed=0 and (cat_id="&cat_id&hx66010&") order by istop desc,art_id DESC"
   Url_Add=Url_Add&"cat_id="&cat_id&"&"
elseif request("keyword")<>"" and (request("select")="art_title" or request("select")="art_content" or request("select")="review" or request("select")="tjuser") then
   sql="select * from joke where passed=0 and "&request("select")&" like '%"&Jencode(checkspace(request("keyword")))&"%' order by istop desc,art_date DESC"
   Url_Add=Url_Add&"select="&request("select")&"&keyword="&Server.URLEncode(request("keyword"))&"&"
else
sql="select * from joke where passed=0 order by istop desc,art_id DESC"
end if
set RsHxcms=server.createobject("adodb.recordset")
RsHxcms.open sql,conn,1,1
Response.Write "<table width='100%' border='1' align='center' cellspacing='0' cellpadding='0' bgcolor='#FFFFFF' bordercolor='#f0f0f0' style='border-collapse: collapse'>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td height=30 colSpan=4><FONT color=#b70000>&nbsp;<B>·</B></FONT>"
if request("cat_id")<> "" then
Response.Write "本分类共有"
elseif request("select")<>"" then
Response.Write "共搜索到"
else
Response.Write "当前共有"
end if
Response.Write "<span>"&RsHxcms.recordcount&"</span>篇笑话</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "<tr align='center'>" & vbCrLf
Response.Write "<TD width='6%' height='26'>状态</TD><td width='*'>主 题</td><TD width='10%'>人气</TD><td width='15%'>发表日期</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
if not RsHxcms.eof then
   Dim Hx_Nums,MultiPages,i
   RsHxcms.PageSize=Hxperpage
   RsHxcms.AbsolutePage=CurPage
   Hx_Nums=RsHxcms.RecordCount
   MultiPages="<tr><td colspan=""4"" height='28' align=""center"">"&MultiPage(Hx_Nums,Hxperpage,CurPage,Url_Add)&"</td></tr>"
Do Until RsHxcms.EOF OR i=Hxperpage
sql="select cat_id,cat_name from joke_cat where cat_id="&RsHxcms("cat_id")
set rscat=server.createobject("adodb.recordset")
rscat.open sql,conn,1,1
if RsHxcms("istop")="1" then      
folder="<img src=""img/1.gif"" title=固顶笑话>"       
else
folder="<img src=""img/4.gif"" title=普通笑话>"       
end if      
if RsHxcms("istop")="0" then      
if RsHxcms("isbest")="1" then
folder="<img src=""img/2.gif"" title=推荐笑话>"
elseif RsHxcms("art_count")>popjokenum then
folder="<img src=""img/3.gif"" title=热门笑话>"       
else
folder="<img src=""img/4.gif"" title=普通笑话>"       
end if      
end if 
dim nnn
if NewWindows=True then
nnn="target='_blank'"
else
nnn=""				
end if     
Response.Write "<tr>" & vbCrLf
Response.Write "<TD align=Center height='26'>"&folder&"</TD><td>"
if classyes=True then Response.Write "<a href='joke_list.asp?cat_id="&RsHxcms("cat_id")&"'>『"&left(rscat("cat_name"),10)&"』</a>"
Response.Write "<a href='showjoke.asp?cat_id="&RsHxcms("cat_id")&"&art_id="&RsHxcms("art_id")&"' Title='笑话标题："&RsHxcms("art_title")&"&#13&#10发表时间："&RsHxcms("art_date")&"&#13&#10阅读次数："&RsHxcms("art_count")&"次' "& nnn &">"&gotTopic(RsHxcms("art_title"),nn)&"</a>"
if RsHxcms("isimg")=1 then
Response.Write "&nbsp;<img src='img/img.gif' alt='笑话站(图片)' align=absmiddle border=0>" & vbCrLf
end if
if DateDiff("h",RsHxcms("art_date"),now())<=24 then
Response.Write "<img src='img/new.gif' alt='24小时内笑话'>" & vbCrLf
end if
Response.Write "</td>"
Response.Write "<TD align=Center>"&RsHxcms("art_count")&"</TD>" & vbCrLf
Response.Write "<TD align=Center>"&year(RsHxcms("art_date"))&"-"&Right("0"&month(RsHxcms("art_date")),2)&"-"&Right("0"&day(RsHxcms("art_date")),2)&"</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
i=i+1
RsHxcms.movenext
loop
else
if RsHxcms.eof and RsHxcms.bof then
Response.Write "<tr align='center'>" & vbCrLf
Response.Write "<td align=middle height='60' colSpan=4>"
if request("cat_id")<> "" then
Response.Write "该分类暂时没有笑话"
elseif request("keyword")<>"" then
Response.Write "没有找到包含[<b><font color=red>"&request("keyword")&"</font></b>]的笑话！"
else
Response.Write "没有任何笑话，请管理员到后台添加！"
end if
Response.Write "</td></tr>" & vbCrLf
end if
end if
Response.Write(MultiPages)
Response.Write "</table>" & vbCrLf
rscat.close
set rscat=nothing
RsHxcms.close
set RsHxcms=nothing
end sub

'=================================================
'过程名：content_art
'作  用：显示笑话标题、内容
'参  数：无
'Web:   www.ynsky.com.cn
'=================================================
sub content_art()
if request.querystring("art_id")="" then
  Response.Write "<script language=javascript>alert('请指定操作的对象！');javascript:history.back();</script>"
  Response.End
end if
if request("page")<>"" then
  if not isInteger(request("page")) then
    Response.Write "<script language=javascript>alert('分页参数非法！');javascript:history.back();</script>"
    Response.End
  end if
end if
if rs("Grade")="0" then
hxGrade="游客身份"
elseif rs("Grade")="1" then
hxGrade="会员身份"       
elseif rs("Grade")="2" then
hxGrade="VIP身份"       
end if %>     
<script language = "JavaScript">
function fontColor(objname)
{
	var arr = showModalDialog("inc/selcolor.htm", "", "dialogWidth:18.5em; dialogHeight:17.5em; status:0; help:0");
	if (arr != null) setColor(objname,arr);
}
</script>


<!--自动弹出网页js始
<SCRIPT Language="JavaScript">function winopen () {msg=open("http://www.51yala.com/union/Count.asp?UserID=581","NewWindow","toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=no,resizable=no,copyhistory=yes,width=10,height=10");}</SCRIPT>
完-->


<%
Response.Write "<table width='100%' align='center' cellspacing='0' cellpadding='0'>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td valign='top'><br><div align='center'><font style=""font-size:16px""><b>"&rs("art_title")&"</b></font></div><br></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td>" & vbCrLf
Response.Write "<table width='95%' align='center' class=""table-top"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td width='4%'>&nbsp;</td>" & vbCrLf
Response.Write "<td width='23%'>笑话作者："&rs("art_author")&"</td>"
Response.Write "<td width='19%'>来源："&rs("art_ahome")&"</td>" 
Response.Write "<td width='21%'>浏览次数："&rs("art_count")&"</td>"
Response.Write "<td width='27%'>字体："
Response.Write "<input type=button style='height:17' value='小' title='把正文字体缩小' onclick=fontSize('m','ArtBody')>" 
Response.Write "<input type=button style='height:17' value='大' title='把正文字体扩大' onclick=fontSize('b','ArtBody')>" 
Response.Write "<input type=button style='height:17' value='简' title='转为简体中文模式' onclick=bodytojt('ArtBody')>" 
Response.Write "<input type=button style='height:17' value='繁' title='转为繁体中文模式' onclick=bodytoft('ArtBody')>" 
Response.Write "<a href=""javascript:fontColor('ArtBody')""><img src='img/fgcolor.gif' alt='字体颜色' border=0 align='absmiddle'></a>"
Response.Write "</td></tr>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td>&nbsp;</td>"
Response.Write "<td>阅读权限：<font color=red>"&hxGrade&"</font></td>"
Response.Write "<td>花费会员币：<font color=red>"&rs("points")&"</font></td>"
if rs("tjuser")="administrator" or rs("tjuser")="游游" or rs("tjuser")="发菜" or rs("tjuser")="admin"    then
Response.Write "<td>提交会员：admin </td>"
else
Response.Write "<td>提交会员："&rs("tjuser")&"</td>"
end if
Response.Write "<td>添加时间："&rs("art_date")&"</td>"
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Response.Write "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Response.Write "<table width='100%' align='center' style=""word-break:break-all;table-layout:fixed;text-align:left"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td valign='top'>" & vbCrLf

'笑话广告<
response.Write"<table align=right float=left border=0><tr><td><script language=javascript src='ad/ads_joke.js'></script></td></tr></table>"
'笑话广告>



Response.Write "<div id=""ArtBody"" style=""display:block;padding-left:15px;LINE-HEIGHT: 180%"">"
if art_images<>"" and art_imgyes=1 then response.write "<a href="&art_images&" target=_blank><img src="&art_images&" align=right onload=""javascript:if(this.width>screen.width-666)this.width=screen.width-666"" border=0 alt=按此在新窗口浏览图片></a>" & vbCrLf
call Showjoke()
Response.Write "</div></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
end sub

'=================================================
'过程名：contextual_Art
'作  用：显示笑话上下篇
'参  数：无
'Web:   www.ynsky.com.cn
'=================================================
sub contextual_Art()
set RelationArt = conn.execute("select top 1 art_id,art_title from joke where art_id<"&request.querystring("art_id")&" and passed=0 order by art_id desc")
IF RelationArt.eof and relationArt.bof Then
Response.Write "<font color=red>·上一笑话：</font>已经没有了<BR> " & vbCrLf    
else
Response.Write "<font color=red>·上一笑话：</font><a href=""showjoke.asp?art_id=" & RelationArt(0) & """>" & relationArt(1) & "</a><BR>" & vbCrLf   
end if   
Set RelationArt=Nothing
set RelationArt = conn.execute("select top 1 art_id,art_title from joke where art_id>"&request.querystring("art_id")&" and passed=0 order by art_id")
IF RelationArt.eof and relationArt.bof Then
Response.Write "<font color=red>·下一笑话：</font>已经没有了" & vbCrLf   
else
Response.Write "<font color=red>·下一笑话：</font><a href=""showjoke.asp?art_id=" & RelationArt(0) & """>" & relationArt(1) & "</a></td>" & vbCrLf  
end if  
Set RelationArt=Nothing 
end sub

'=================================================
'过程名：pertinent_Art
'作  用：显示相关笑话
'参  数：无
'Web:   www.ynsky.com.cn
'=================================================
sub pertinent_Art(n)
Response.Write "<table width=""98%"" align=""center"" bgcolor=""#FCFCFC"">" & vbCrLf
Response.Write "<tr><td background=""img/bg.gif"" style=""display:block;padding:0px 10px;LINE-HEIGHT: 210%"">"
dim strKey,arrKey,i
strKey=rs("art_keyword")
	if instr(strkey,"|")>1 then
		arrKey=split(strKey,"|")
		strKey="((art_keyword like '%" & arrKey(0) & "%')"
		for i=1 to ubound(arrKey)
			strKey=strKey & " or (art_keyword like '%" & arrKey(i) & "%')"
		next
		strKey=strKey & ")"
	else
		strKey="(art_keyword like '%" & strKey & "%')"
	end if
sql="select top " & n & " * from joke where " & strKey & " and art_id <> "&rs("art_id")&" and passed = 0 order by art_id DESC"
set rs2=server.createobject("adodb.recordset")
rs2.open sql,conn,1,1
do while not rs2.eof
Response.Write "·<a href='showjoke.asp?art_id="&rs2("art_id")&"'>"&rs2("art_title")&"</a> "&rs2("art_date")&"<br>" & vbCrLf  
rs2.movenext
loop
if rs2.eof and rs2.bof then
response.write "没有相关笑话<br>"
end if
rs2.close
set rs2=nothing
Response.Write "</td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
end sub

'=================================================
'过程名：review_Art
'作  用：显示相关评论
'参  数：n-显示条数；point_article-评论开关,1-开启，0-关闭
'Web:   www.ynsky.com.cn
'=================================================
sub review_Art(n)
dim temp,i,j
if point_article="1" then
Response.Write "<table align=""center"" width=""98%"" cellspacing=""0"" cellpadding=""0"" style=""word-break:break-all;table-layout:fixed;text-align:left"">"
if rs("review")<>"" then
temp=split(Trim(rs("review")),"|")
if n>=ubound(temp) then
j=ubound(temp)
else
j=n
end if
for i=1 to j
Response.Write "<tr><td style=""display:block;padding:0px 10px;LINE-HEIGHT: 180%"">"& temp(i) &"</td></tr>" & vbCrLf
next
else
Response.Write "<tr><td style=""display:block;padding:0px 10px;LINE-HEIGHT: 180%"">当前没有评论</td></tr>" & vbCrLf
end if
Response.Write "<tr><td align=""right"">相关评论<font color=#CC0000> "&rs("reviewcount")&" </font>篇，当前显示最新的<font color=#CC0000> "&n&" </font>篇。&nbsp;&nbsp;<a href=""view.asp?action=joke&art_id="&rs("art_id")&"""> [查看更多评论] [发表我的评论]</a>&nbsp;&nbsp;</td></tr>"
Response.Write "</table>" & vbCrLf
elseif point_article="0" then
Response.Write "<table width=""100%"" cellpadding=""5"" cellspacing=""0"" border=""0"">" & vbCrLf
Response.Write "<tr><td  align=""center"">【笑话站评论已关闭】" & vbCrLf
Response.Write "</td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
End If
rs.close
set rs=nothing
end sub

'=================================================
'过程名：ShowArt
'作  用：显示笑话内容，可以分页显示
'参  数：无
'Web:   www.ynsky.com.cn

'=================================================
sub Showjoke()
dim ArticleID
Pay=request("Pay")
ArticleID=md5(trim(request("art_id"))+123)
'ArticleID=trim(request("art_id"))
	if rs("Grade")<>0 then
		if UserLogined<>True then 
			FoundErr=True
			ErrMsg=ErrMsg & "<font color=red>·</font>你还没注册？或者没有登录？这篇笑话要求至少是本站的注册用户才能阅读！<br>"
			ErrMsg=ErrMsg & "<font color=red>·</font>如果你还没注册，请赶紧<a href='UserReg.asp'> <font color=red>点此注册</font></a> ！<br>"
			ErrMsg=ErrMsg & "<font color=red>·</font>如果你已经注册但还没登录，请赶紧 <a href='index.asp'><font color=red>点此登录</font></a> ！<br><br>"
		else
			if Hx66_Grade+1<RS("Grade") then
				FoundErr=True
				ErrMsg=ErrMsg & "<p align='center'><br><font color=red><b>对不起，你的权限不够，不能阅读此笑话!</b></font></p><br>"
			else
				if rs("points")>0 then
					if Request.Cookies("hx66")("Pay_Art" & ArticleID)<>"yes" then
						if Hx66_points<rs("points") then
							FoundErr=True
							ErrMsg=ErrMsg &"<p align='center'><br>对不起，阅读本文需要消耗 <b><font color=red>" & rs("points") & "</font></b> "& moneyname &"！"
							ErrMsg=ErrMsg &"而你目前只有 <b><font color=blue>" & Hx66_points & "</font></b> "& moneyname &"可用。"& moneyname &"不足，无法阅读本文。请与我们联系进行充值。</p>"
						else
							if lcase(trim(request("Pay")))="yes" then
                                                             sql="UPDATE [user] SET points = points - "&rs("points")&" where userid="&Hx66_uid
                                                             conn.execute (sql)
                                                             response.Cookies("hx66")("Pay_Art" & ArticleID)="yes"
                                                             Response.Cookies("hx66").Expires=date+365
							else
							     FoundErr=True
							     ErrMsg=ErrMsg &"<p align='center'><br>阅读本文需要消耗 <b><font color=red>" & rs("points") & "</font></b> "& moneyname &"！"
							     ErrMsg=ErrMsg &"你目前尚有 <b><font color=blue>" & Hx66_points & "</font></b> "& moneyname &"可用。阅读本文后，你将剩下 <b><font color=green>" & Hx66_points-rs("points") & "</font></b> "& moneyname &""
							     ErrMsg=ErrMsg &"<br>你确实愿意花费 <b><font color=red>" & rs("points") & "</font></b> "& moneyname &"来阅读本文吗？"
							     ErrMsg=ErrMsg &"<br><br><a href='?Pay=yes&art_id=" & rs("art_id") & "'>我愿意</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href='index.asp'>我不愿意</a></p><br>"
							end if
						end if
					end if
				end if
			end if
		end if
	end if

	if FoundErr=True then
	        ErrMsg="<p align=left><b>内容预览：</b></p><p align=left><table style='width:95%' cellpadding=5 cellspacing=1 class=tablegubb><TR><TD width='100%' bgcolor='#FFFFFF'>" & left(rs("art_content"),100) & "……</td></tr></table></p>" & ErrMsg
		response.write ErrMsg
		exit sub
	end if

dim PaginationType
PaginationType=rs("PaginationType")
select case PaginationType
	case 0    '不分页显示
		response.write rs("art_content")
	case 1    '自动分页显示
		call AutoPagination()
	case 2    '手动分页显示
		call ManualPagination()
end select
end sub
'=================================================
'过程名：ManualPagination
'作  用：采用手动分页方式显示笑话内容
'参  数：无
'Web:   www.ynsky.com.cn
'=================================================
sub ManualPagination()
dim ArtID,strContent,CurrentPage
dim ContentLen,MaxPerPage,pages,i
dim arrContent
ArtID=rs("art_id")
strContent=rs("art_content")
ContentLen=len(strContent)
CurrentPage=trim(request("Page"))
if Instr(strContent,"[NextPage]")<=0 then
	response.write strContent
	response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
else
	arrContent=split(strContent,"[NextPage]")
	pages=Ubound(arrContent)+1
	if CurrentPage="" then
		CurrentPage=1
	else
	CurrentPage=Cint(CurrentPage)
	end if
	if CurrentPage<1 then CurrentPage=1
	if CurrentPage>pages then CurrentPage=pages
	response.write arrContent(CurrentPage-1)
	response.write "</p><p align='center'><b>"
	if CurrentPage>1 then
		response.write "<a href='showjoke.asp?art_id="&ArtID&"&page="&CurrentPage-1&"'>上一页</a>&nbsp;"
	end if
	for i=1 to pages
		if i=CurrentPage then
			response.write "<font color='red'>[" & cstr(i) & "]</font>&nbsp;"
		else
			response.write "<a href='showjoke.asp?art_id="&ArtID&"&page="&i&"'>["& i &"]</a>&nbsp;"
		end if
	next
	if CurrentPage<pages then
		response.write "<a href='showjoke.asp?art_id="&ArtID&"&page="&CurrentPage+1&"'>下一页</a>"
	end if
	response.write "</b></p>"
end if
end sub
'=================================================
'过程名：AutoPagination
'作  用：采用自动分页方式显示笑话内容
'参  数：无
'Web:   www.ynsky.com.cn
'=================================================
sub AutoPagination()
dim ArtID,strContent,CurrentPage
dim ContentLen,MaxPerPage,pages,i,lngBound
dim BeginPoint,EndPoint
ArtID=rs("art_id")
strContent=rs("art_content")