📄 index.cls
字号:
rsPic.Open sqlPic, Conn, 1, 1
strPic = "<table width='100%' cellpadding='0' cellspacing='5' border='0' align='center'><tr valign='top'>"
If rsPic.BOF And rsPic.EOF Then
strPic = strPic & "<td align='center'><img src='images/NoPic.jpg' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>没有任何图片文章</td>"
Else
i = 0
If ShowType = 1 Then
Do While Not rsPic.EOF
strPic = strPic & "<td align='center'>"
Call GetPicArticleTitle(TitleLen, ImgWidth, ImgHeight)
strPic = strPic & "</td>"
rsPic.MoveNext
i = i + 1
If ((i Mod Cols = 0) And (Not rsPic.EOF)) Then strPic = strPic & "</tr><tr valign='top'>"
Loop
ElseIf ShowType = 2 Then
Do While Not rsPic.EOF
strPic = strPic & "<td align='center'>"
Call GetPicArticleTitle(TitleLen, ImgWidth, ImgHeight)
strPic = strPic & "</td><td valign='top' algin='center' class='left'><a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "'>" & Left(nohtml(rsPic("Content")), ContentLen) & "……</a></td>"
rsPic.MoveNext
i = i + 1
If ((i Mod Cols = 0) And (Not rsPic.EOF)) Then strPic = strPic & "</tr><tr valign='top'>"
Loop
End If
End If
strPic = strPic & "</tr></table>"
Response.Write strPic
rsPic.Close
End Sub
'=================================================
'过程名：ShowElite
'作 用：显示推荐文章
'参 数：ArticleNum ----最多显示多少篇文章
' TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
Sub ShowElite(ArticleNum, TitleLen)
Dim sqlElite, rsElite
If ArticleNum > 0 And ArticleNum <= 100 Then
sqlElite = "select top " & ArticleNum
Else
sqlElite = "select top 10"
End If
sqlElite = sqlElite & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=0 and A.Passed=1 And A.Elite=1 order by A.articleid desc"
Set rsElite = Server.CreateObject("ADODB.Recordset")
rsElite.Open sqlElite, Conn, 1, 1
If TitleLen < 0 Or TitleLen > 255 Then TitleLen = 50
If rsElite.BOF And rsElite.EOF Then
Response.Write "<li>无推荐文章</li>"
Else
Do While Not rsElite.EOF
Response.Write "<tr class='listbg'><td width='10'><img src='Images/article_elite.gif'> </td><td><a href='ShowArticle.asp?ArticleID=" & rsElite("articleid") & "' title='文章标题：" & rsElite("Title") & vbCrLf & "作 者：" & rsElite("Author") & vbCrLf & "更新时间：" & rsElite("UpdateTime") & vbCrLf & "点击次数：" & rsElite("Hits") & "' target='_blank'>" & gotTopic(rsElite("title"), TitleLen) & "</a>[<font color=red>" & rsElite("hits") & "</font>]</td></tr>"
rsElite.MoveNext
Loop
End If
rsElite.Close
Set rsElite = Nothing
End Sub
'=================================================
'过程名：ShowHot
'作 用：显示热门文章
'参 数：ArticleNum ----最多显示多少篇文章
' TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
Sub ShowHot(ArticleNum, TitleLen)
Dim sqlHot, rsHot
If ArticleNum > 0 And ArticleNum <= 7 Then
sqlHot = "select top " & ArticleNum
Else
sqlHot = "select top 7 "
End If
sqlHot = sqlHot & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=0 and A.Passed=1 And A.Hits>=" & HitsOfHot & " order by A.ArticleID desc"
Set rsHot = Server.CreateObject("ADODB.Recordset")
rsHot.Open sqlHot, Conn, 1, 1
If TitleLen < 0 Or TitleLen > 255 Then TitleLen = 50
If rsHot.BOF And rsHot.EOF Then
Response.Write "<li>无热门文章</li>"
Else
Do While Not rsHot.EOF
Response.Write "<tr class='listbg'><td width='10'><img src='Images/article_elite.gif'> </td><td><a href='ShowArticle.asp?ArticleID=" & rsHot("articleid") & "' title='文章标题：" & rsHot("Title") & vbCrLf & "作 者：" & rsHot("Author") & vbCrLf & "更新时间：" & rsHot("UpdateTime") & vbCrLf & "点击次数：" & rsHot("Hits") & "' target='_blank'>" & gotTopic(rsHot("title"), TitleLen) & "</a>[<font color=red>" & rsHot("hits") & "</font>]</td></tr>"
rsHot.MoveNext
Loop
End If
rsHot.Close
Set rsHot = Nothing
End Sub
'=================================================
'过程名：ShowSpecial
'作 用：以竖向列表方式显示专题名称
'参 数：SpecialNum ------最多显示多少个专题名称
'=================================================
Sub ShowSpecial(SpecialNum)
Dim i
i = 1
If SpecialNum <= 0 Or SpecialNum > 100 Then
SpecialNum = 10
End If
sqlSpecial = "select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
Set rsSpecial = Server.CreateObject("ADODB.Recordset")
rsSpecial.Open sqlSpecial, Conn, 1, 1
totalPut = rsSpecial.RecordCount
If rsSpecial.BOF And rsSpecial.EOF Then
Response.Write " 没有任何专题栏目"
Else
rsSpecial.MoveFirst
Do While Not rsSpecial.EOF
Response.Write ("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
rsSpecial.MoveNext
i = i + 1
If i > SpecialNum Then Exit Do
Loop
End If
If Not rsSpecial.EOF Then
Response.Write "<p align='right'><a href='Special.asp'>更多专题</a></p>"
End If
End Sub
'=================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'=================================================
Sub ShowUserLogin()
Dim strLogin
If CheckUserLogined() = False Then
strLogin = "<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbCrLf
strLogin = strLogin & "<form action='UserChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbCrLf
strLogin = strLogin & "<tr><td height='25' align='right'>用户名：</td><td height='25'><input name='UserName' type='text' id='UserName' size='10' maxlength='20'></td></tr>" & vbCrLf
strLogin = strLogin & "<tr><td height='25' align='right'>密 码：</td><td height='25'><input name='Password' type='password' id='Password' size='10' maxlength='20'></td></tr>" & vbCrLf
strLogin = strLogin & "<tr><td height='25' align='right'>Cookie：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbCrLf
strLogin = strLogin & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td></tr>" & vbCrLf
strLogin = strLogin & "<tr align='center'><td height='30' colspan='2'><input name='Login' type='submit' id='Login' value=' 登录 '> <input name='Reset' type='reset' id='Reset' value=' 清除 '>" & vbCrLf
strLogin = strLogin & "<br><br><a href='UserReg.asp' target='_blank'>新用户注册</a> <a href='GetPassword.asp'>忘记密码？</a><br></td>" & vbCrLf
strLogin = strLogin & "</tr></form></table>" & vbCrLf
Response.Write strLogin
Else
Response.Write "<br>欢迎您！" & Trim(Request.Cookies("asp163")("UserName")) & "<br><br>"
Response.Write "<b>用户控制面板：</b><br>" & vbCrLf
Response.Write " <a href=""JavaScript:openScript('UserControlPad.asp?Action=ArticleAdd')"">发表文章</a>" & vbCrLf
Response.Write " <a href=""JavaScript:openScript('UserControlPad.asp?Action=ArticleManage')"">文章管理</a><br>" & vbCrLf
Response.Write " <a href=""JavaScript:openScript('UserControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbCrLf
Response.Write " <a href=""JavaScript:openScript('UserControlPad.asp?Action=ModifyInfo')"">个人信息</a><br>" & vbCrLf
Response.Write "<div align='center'><a href='UserLogout.asp'>【注销登录】</a></div>" & vbCrLf
End If
End Sub
Public Sub allcontent()
Set rsPic = Server.CreateObject("ADODB.Recordset")
Set rsArticle = Server.CreateObject("ADODB.Recordset")
Dim sqlRoot As String
Dim rsRoot As ADODB.Recordset
Dim trs As ADODB.Recordset
Dim arrClassID
Dim TitleStr As String
Dim ClassCount
Dim iClassID
sqlRoot = "select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,L.LayoutID,C.Child From ArticleClass C inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 and IsElite=1 and LinkUrl='' order by C.RootID"
Set rsRoot = Server.CreateObject("ADODB.Recordset")
rsRoot.Open sqlRoot, Conn, 1, 1
If rsRoot.BOF And rsRoot.EOF Then
Response.Write ("<td>还没有任何栏目，请首先添加栏目。</td>")
Else
ClassCount = rsRoot.RecordCount
iClassID = 0
Do While Not rsRoot.EOF
Response.Write "<td valign='top' width='285'><table width='100%' border='0' cellspacing='0' cellpadding='0'><tr><td><table class='main_title_575' cellspacing='0' cellpadding='0' width='100%' border='0'><tr><td width='12%'><img height='34' src='Images/homedha3.gif' width='55'></td><td width='80%' background='Images/homedhbg.gif'>"
arrClassID = rsRoot(0)
Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "'>" & rsRoot(1) & "</a>"
If rsRoot(5) > 0 Then
Set trs = Conn.Execute("select ClassID from ArticleClass where RootID=" & rsRoot(2) & " and Child=0 and LinkUrl=''")
Do While Not trs.EOF
arrClassID = arrClassID & "," & trs(0)
trs.MoveNext
Loop
End If
Response.Write "</td><td align='middle' width='8%'><a href='ShowClass.asp?ClassID='" & rsRoot(0) & "'><img height='12' src='Images/new_more.gif' width='42' border='0'></a></td></tr></table></td></tr><tr><td><table width='100%' border='0' cellpadding='0' cellspacing='0'><tr><td class='main_tdbg_282' style='BORDER-RIGHT: #e6e6e6 1px solid' valign='top' background='Images/FGBG.gif'><table width='100%' height='100%' border='0' cellpadding='0' cellspacing='0'><tr><td valign='top'><table cellspacing='0' cellpadding='0' width='100%'>"
sql = "select top 8 A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.[Key],A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
sql = sql & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sql = sql & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 and A.ClassID in (" & arrClassID & ") order by A.OnTop,A.ArticleID desc"
rsArticle.Open sql, Conn, 1, 1
If rsArticle.BOF And rsArticle.EOF Then
Response.Write "<li>没有任何文章</li>"
Else
Call ArticleContent(26, True, True, False, 0, False, True)
End If
rsArticle.Close
Response.Write "</table></td></tr></table></td> </tr></table></td></tr></table></td>"
iClassID = iClassID + 1
If iClassID Mod 2 = 0 Then
Response.Write "</tr><tr>"
Else
Response.Write "<td width='5'></td>"
End If
rsRoot.MoveNext
Loop
End If
rsRoot.Close
Set rsRoot = Nothing
End Sub
Public Function ArticleList()
MaxPerPage = 40
strFileName = "ShowClass.asp?ClassID=" & ClassID & "&SpecialID=" & SpecialID
Set rsArticle = Server.CreateObject("ADODB.Recordset")
Set rsPic = Server.CreateObject("ADODB.Recordset")
Dim sqlRoot, rsRoot, trs, arrClassID, TitleStr
sqlRoot = "select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,L.LayoutID,C.Child,C.ParentPath From ArticleClass C inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & ClassID & " and C.IsElite=1 and C.LinkUrl='' and C.BrowsePurview>=" & UserLevel & " order by C.OrderID"
Set rsRoot = Server.CreateObject("ADODB.Recordset")
rsRoot.Open sqlRoot, Conn, 1, 1
If rsRoot.BOF And rsRoot.EOF Then
Response.Write "<table cellspacing='0' cellpadding='0' width='100%' border='0'><tr><td class='main_title_575' style='background-image: url('url(')'Images/homedhbg.gif')'><img src='Images/homedha3.gif' align='absMiddle'>" & ClassName & "文章列表</td></tr><tr><td class='main_tdbg_575' valign='top' background='Images/FGBG2.gif'><table cellspacing='0' cellpadding='0' width='100%'><tr class='listbg'><td width='10'>"
Call ShowArticle(60)
Response.Write "</td></tr></table></td></tr><tr><td class='main_tdbg_575' valign='top'>"
If totalPut > 0 Then
Call showpage(strFileName, totalPut, MaxPerPage, False, True, "篇文章")
End If
Response.Write "</td></tr></table>"
Else
Do While Not rsRoot.EOF
Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'><tr><td class='main_title_575' style='background-image: url('url(')'Images/homedhbg.gif')'><img src='Images/homedha3.gif' align='absMiddle'>"
arrClassID = rsRoot(0)
Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "'>" & rsRoot(1) & "</a>"
If rsRoot(5) > 0 Then
Response.Write "："
Set trs = Conn.Execute("select top 4 C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,L.LayoutID From ArticleClass C inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & rsRoot(0) & " and C.IsElite=1 and C.LinkUrl='' and C.BrowsePurview>=" & UserLevel & " order by C.OrderID")
Do While Not trs.EOF
Response.Write " <a href='ShowArticle.asp?ClassID=" & trs(0) & "'>" & trs(1) & "</a>"
trs.MoveNext
Loop
Set trs = Conn.Execute("select ClassID from ArticleClass where ParentID=" & rsRoot(0) & " or ParentPath like '%" & rsRoot(6) & "," & rsRoot(0) & ",%' and Child=0 and LinkUrl='' and BrowsePurview>=" & UserLevel)
Do While Not trs.EOF
arrClassID = arrClassID & "," & trs(0)
trs.MoveNext
Loop
End If
Response.Write "</td></tr></table><table width='100%' border='0' cellpadding='0' cellspacing='0'><tr><td>"
sql = "select top 5 A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.[Key],A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
sql = sql & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sql = sql & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 and A.ClassID in (" & arrClassID & ") order by A.OnTop,A.ArticleID desc"
rsArticle.Open sql, Conn, 1, 1
If rsArticle.BOF And rsArticle.EOF Then
Response.Write "<li>没有任何文章</li>"
Else
Call ArticleContent(60, True, True, True, 2, True, True)
End If
rsArticle.Close
Response.Write "</td></tr><tr><td width='96%' height='20' align='right'><a href='ShowArticle.asp?ClassID='" & rsRoot(0) & "'>更多>>></a></td></tr>"
rsRoot.MoveNext
Loop
End If
rsRoot.Close
Set rsRoot = Nothing
Response.Write "</table>"
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -