create_articlecls.asp

来自「多用户管理分权限发布、管理软件信息;  自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 897 行 · 第 1/3 页

ASP
897
字号
		Else
			If CInt(Newasp.Setting(5)) = 0 Then
				HtmlString = "<a href=" & Newasp.SetupDir & "Article/Catalog" & Rss("classid") & "/" & Rss("id") & ".html>" & Rss("title") & "</a>"
			Else
				HtmlString = "<a href=" & Newasp.SetupDir & "Article.Asp?id=" & Rss("id") & ">" & Rss("title") & "</a>"
			End If
		End If
		Rss.Close
		Set Rss = Nothing
		FormerArticle = HtmlString
	End Function

	Private Function NextArticle(articleid)
		Dim Rss, SQL, HtmlString
		Set Rss = Server.CreateObject("adodb.recordset")
		SQL = "select id,classid,title from NC_Article where id = " & articleid + 1
		Rss.Open SQL, Conn, 1, 1
		If Rss.EOF And Rss.bof Then
			HtmlString = Newasp.TempSet(3)
		Else
			If CInt(Newasp.Setting(5)) = 0 Then
				HtmlString = "<a href=" & Newasp.SetupDir & "Article/Catalog" & Rss("classid") & "/" & Rss("id") & ".html>" & Rss("title") & "</a>"
			Else
				HtmlString = "<a href=" & Newasp.SetupDir & "Article.Asp?id=" & Rss("id") & ">" & Rss("title") & "</a>"
			End If
		End If
		Rss.Close
		Set Rss = Nothing
		NextArticle = HtmlString
	End Function
	'*************************************************************
	'函数作用:热门文章
	'*************************************************************
	Private Function GetHotArticle()
		Dim Rs, SQL, HtmlString, HotTopic, ClassName, InfoTime
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(Newasp.TempSet(4)) & " id,classid,Title, ClassName,InfoTime,Hits from NC_Article where isLock = 0 order by Hits desc, InfoTime desc, id desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "还没有热门文章!"
		Else
			Do While Not Rs.EOF
				If Rs("InfoTime") >= Date Then
					InfoTime = "<FONT color=red>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
				Else
					InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
				End If
				If CInt(Newasp.Setting(5)) = 0 Then
					HotTopic = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='" & Rs(2) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(5))) & "</A>"
				Else
					HotTopic = "<A HREF='" & Newasp.SetupDir & "Article.asp?id=" & Rs(0) & "' title='" & Rs(2) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(5))) & "</A>"
				End If
				HtmlString = HtmlString & Newasp.TempSet(6)
				HtmlString = Replace(HtmlString, "{$HotTopic}", HotTopic)
				HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
				HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		GetHotArticle = HtmlString
	End Function

	Private Sub CreateMain()
		SQL = "select count(*) from NC_Article"
		Rs1 = Conn.Execute(SQL)
		ArticleTotal = Rs1(0)
		Response.Write "<table width=""98%"" border=""0"" align=""center"" cellpadding=""5"" cellspacing=""1"" class=""tableBorder"">"
		Response.Write " <tr>" & Chr(13)
		Response.Write " <th colspan=""2"">批量生成文章内容HTML页</th></tr>"
		Response.Write " <tr>" & Chr(13)
		Response.Write " <td class=forumrow height=""32"" style=""LINE-HEIGHT: 150%; font-size: 10pt;"" colspan=""2"">"
		If Request("type") = "ok" Then
			Response.Write "操作成功:共生成页面<font color=""#FF0000"">" & Request("num") & "</font>个,总费时<font color=""#FF0000"">" & FormatNumber((Timer() - Request("D")), 2) & "</font>秒,完成时间" & Now() & ""
		End If
		Response.Write "</td>"
		Response.Write "</tr>"
		Response.Write " <tr><form name=""myform"" method=""post"" action=""?action=Create&type=date"">"
		Response.Write " <td class=forumrow height=""32"" width=""30%"">按日期生成内容Html页</td>"
		Response.Write " <td class=forumrow width=""70%"">"
		Response.Write " <select size=""1"" name=""datYear"">"
		For i = 2001 To Year(Date)
			Response.Write "<option value=""" & i & """"
			If i = Year(Date) Then
				Response.Write " selected"
			End If
			Response.Write ">" & i & "</option>"
		Next
		Response.Write " </select> - "
		Response.Write " <select size=""1"" name=""datMonth"">"
		For i = 1 To 12
			Response.Write "<option value=""" & i & """"
			If i = Month(Date) Then
				Response.Write " selected"
			End If
			Response.Write ">" & i & "</option>"
		Next
		Response.Write " </select> - "
		Response.Write " <select size=""1"" name=""datDay"">"
		For i = 1 To 31
			Response.Write "<option value=""" & i & """"
			If i = Day(Date) Then
				Response.Write " selected"
			End If
			Response.Write ">" & i & "</option>"
		Next
		Response.Write " </select> "
		Response.Write "<input type=""submit"" class=button name=""Submit"" value=""生成HTML页""></td>"
		Response.Write " </tr></form>"
		Response.Write " <tr><form name=myform method=""post"" action=""?action=Create&type=new"">"
		Response.Write " <td class=forumrow height=""22"">按个数生成文章Html页</td>"
		Response.Write " <td class=forumrow><input size=10 name=""newnum"" value=""1""> <input type=""submit"" name=""Submit"" class=button value=""生成HTML页""> *将按最近更新的顺序生成</td>"
		Response.Write " </tr></form>"
		Response.Write " <tr><form name=myform method=""post"" action=""?action=Create&type=seid"">"
		Response.Write " <td class=forumrow height=""22"">按文章起始ID生成Html页</td>"
		Response.Write " <td class=forumrow>开始ID:<input size=6 name=""StartID"" value=""1""> 结束ID:<input size=6 name=""EndID"" value=""10"">  <input type=""submit"" name=""Submit"" class=button value=""生成HTML页""> </td>"
		Response.Write " </tr></form>"
		Response.Write " <tr><form name=""myform"" method=""post"" action=""?action=Create"">"
		Response.Write " <td class=forumrow height=""22"">生成全部文章HTML页</td>"
		Response.Write " <td class=forumrow><input type=""submit"" class=button name=""Submit"" value=""生成HTML页""> "
		Response.Write " <input type=radio name=type checked value=""update""> 生成已更新"
		Response.Write " <input type=radio name=type value=""all""> 生成全部"
		Response.Write "</td></form>"
		Response.Write " </tr>"
		Response.Write " <tr><form name=""myform"" method=""post"" action=""?action=update"">"
		Response.Write " <td class=forumrow height=""22"">更新全部文章</td>"
		Response.Write " <td class=forumrow> <input type=""submit"" class=button name=""Submit"" value=""更新全部文章""> "
		Response.Write "</td></form>"
		Response.Write " </tr>"
		Response.Write " <tr>"
		Response.Write " <td colspan=""2"" align=""center"" noWrap class=forumrow height=""22"">"
		Response.Write " <input type=""button"" class=button name=""Submit1"" onclick=""javascript:location.href='Create_ArticleIndex.Asp'"" value=""生成文章首页"">"
		Response.Write " <input type=""button"" class=button name=""Submit4"" onclick=""javascript:location.href='Create_HotArticle.Asp'"" value=""生成热门文章"">"
		Response.Write " <input type=""button"" class=button name=""Submit4"" onclick=""javascript:location.href='Create_NewArticle.Asp'"" value=""生成更新文章"">"
		Response.Write " <input type=""button"" class=button name=""Submit5"" onclick=""javascript:location.href='Create_HotTopJs.asp'"" value=""生成排行JS"">"
		Response.Write "</td>"
		Response.Write " </tr>"
		Response.Write " <tr>"
		Response.Write " <td align=""center"" class=forumrow height=""22"" style=""LINE-HEIGHT: 150%; font-size: 10pt;"" colspan=""2"">"
		Response.Write " (共有文章 <font color=""#FF3300""><B>"
		Response.Write ArticleTotal
		Response.Write "</B></font> 个)"
		Response.Write "</td>"
		Response.Write "</tr></table>"
	End Sub

	Private Sub CreateArticleHtml()
		If CLng(Request.Form("StartID")) > CLng(Request.Form("EndID")) Then Response.Write ("<script>alert('对不起!你输入的开始ID比结束ID大,请重新输入。');history.go(-1)</script>")
		Response.Write "<b><font color=""RED"">正在生成文章内容页的HTML文件,请稍候......</font></b><BR>" & vbCrLf
		Response.Write "<table width=""400"" border=""0"" cellspacing=""1"" cellpadding=""1"">" & vbCrLf
		Response.Write "<tr> " & vbCrLf
		Response.Write "<td bgcolor=000000>" & vbCrLf
		Response.Write " <table width=""400"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
		Response.Write "<tr> " & vbCrLf
		Response.Write "<td bgcolor=ffffff height=9><img src=""images/bar9.gif"" width=0 height=16 id=img2 name=img2 align=absmiddle></td></tr></table>" & vbCrLf
		Response.Write "</td></tr></table></td></tr><tr> " & vbCrLf
		Response.Write "<td align=center bgcolor=000000> <span id=txt2 name=txt2 style=""font-size:9pt"">0</span><span style=""font-size:9pt"">%</span>  <span id=txt3 name=txt3 style=""font-size:9pt"">0</span></td></tr>" & vbCrLf
		Response.Write "</table>" & vbCrLf
		Response.Flush
		Set Rs1 = CreateObject("adodb.recordset")
		startime = Timer
		If Request("type") = "date" Then
			If Newasp.isSqlDataBase = 1 Then
				datDate = "" & Request("datYear") & "-" & Request("datMonth") & "-" & Request("datDay") & ""
				SQL = "select ID,Title from [NC_Article] where datediff(d,InfoTime,getdate())=" & DateDiff("d", datDate, Now()) & " order by ID desc"
			Else
				datDate = "" & Request("datYear") & "-" & Request("datMonth") & "-" & Request("datDay") & ""
				SQL = "select ID,Title from [NC_Article] where InfoTime like '%" & datDate & "%' order by ID desc"
			End If
		End If
		If Request("type") = "new" Then
			If Request("newnum") > 0 And Len(Request("newnum")) <> 0 Then
				SQL = "select top " & CInt(Request("newnum")) & " ID,Title from NC_Article order by InfoTime desc,ID desc"
			Else
				Response.Write "<meta http-equiv=""refresh"" content=""0;url='" & Request.ServerVariables("HTTP_REFERER") & "'"">"
			End If
		End If
		If Request("type") = "all" Then
			SQL = "select ID,Title from NC_Article order by ID desc"
		End If
		If Request("type") = "update" Then
			SQL = "select ID,Title from NC_Article where isUpdate=1 order by ID desc"
		End If
		If Request("type") = "seid" Then
			SQL = "select ID,Title from NC_Article where ID >= " & Request("StartID") & " and ID <= " & Request("EndID") & " order by ID desc"
		End If
		If Request("p") <> "" Then
			p = CLng(Request("p"))
			d = Request("D")
		Else
			p = 1
			d = startime
		End If
		maxperpage = 100
		Rs1.Open SQL, Conn, 1, 1
		If Not Rs1.EOF Then
			Rs1.pagesize = maxperpage '得到每页数
			TotalPage = Rs1.pagecount '得到总页数
			ArticleTotal = Rs1.recordcount '得到总数
			Rs1.MoveFiRst
			Rs1.Move (p - 1) * maxperpage
			j = (p - 1) * maxperpage + 1
			Do While Not Rs1.EOF
				CreateArticle (CStr(Rs1("ID")))
				Newasp.Execute ("update NC_Article set isUpdate = 0 where ID=" & Rs1("ID"))
				i = i + 1
				Response.Write "<script>img2.width=" & Fix((i / maxperpage) * 400) & ";" & vbCrLf
				Response.Write "txt2.innerHTML=""完成进度:" & FormatNumber(i / maxperpage * 100, 2, -1) & """;" & vbCrLf
				Response.Write "txt3.innerHTML=""  共有文章 <B><font color=RED>" & ArticleTotal & "</font></B> 个  正在生成第 " & j & " 个"";" & vbCrLf
				Response.Write "img2.title=""(" & i & ")"";</script>" & vbCrLf
				Response.Flush
				Response.Write "<table cellpadding=0 cellspacing=0 border=0 width=90% align=center><tr><td colspan=2 class=forumrow>   生成文章 [" & Rs1(1) & "] 完成。</td></tr></table>"
				Response.Flush
				If i >= maxperpage Then Exit Do
				Rs1.movenext
				j = j + 1
			Loop
		End If
		Rs1.Close
		ArticleNumber = maxperpage * p - maxperpage + 1
		totalnumber = ArticleNumber + i - 1
		If ArticleTotal < ArticleNumber Then
			Set Rs1 = Nothing
			Response.Write "<script>img2.width=400;txt2.innerHTML=""100"";</script>"
			If Newasp.EncryptKeyCode = False Then
				Response.Write "<meta http-equiv=""refresh"" content=""0;url='" & Newasp.SetupDir & "admin/showerr.asp?action=keyerr'"">"
			Else
				Response.Write "<meta http-equiv=""refresh"" content=""0;url='?type=ok&num=" & Request("num") & "&D=" & d & "&p=" & p + 1 & "'"">"
			End If
		Else
			Response.Write "<script>img2.width=400;txt2.innerHTML=""100"";</script>"
			Response.Write "<meta http-equiv=""refresh"" content=""0;url='?action=Create&type=" & Request("type") & "&seid=" & Request("seid") & "&StartID=" & Request("StartID") & "&EndID=" & Request("EndID") & "&update=" & Request("update") & "&newnum=" & Request("newnum") & "&datYear=" & Request("datYear") & "&datMonth=" & Request("datMonth") & "&datDay=" & Request("datDay") & "&num=" & totalnumber & "&D=" & d & "&p=" & p + 1 & "'"">"
		End If
	End Sub

	Public Sub NewArticle()
		stype = Replace(Request("type"), "'", "''")
		If CInt(Newasp.Setting(5)) = 0 Then Response.redirect (Newasp.SetupDir & "Article/NewArticle.html")
		Response.Write NewArticleInfo(stype)
	End Sub

	Public Sub Init_CreateNewArticle()
		Server.ScriptTimeout = 99999
		Set NC_Admin = New Check
		NC_Admin.AdminChk = "36"
		NC_Admin.Check
		Newasp.admin_header
		If CInt(Newasp.Setting(5)) = 1 Then
			NC_Admin.Error_Msg ("对不起!你选择动态ASP程序,不能生成HTML文件,请在基本设置修改成静态HTML方能生成THML文件。")
			Exit Sub
		End If
		ArtType = Split(Newasp.Setting(36), ",")
		For ii = 0 To UBound(ArtType)
			FileName = Newasp.SetupDir & "Article/NewArticle" & ii & ".html"
			HtmlTempStr = NewArticleInfo(ArtType(ii))
			Newasp.CreateNewFiles FileName, HtmlTempStr
		Next
		FileName = Newasp.SetupDir & "Article/NewArticle.html"
		HtmlTempStr = NewArticleInfo("")
		Newasp.CreateNewFiles FileName, HtmlTempStr
		NC_Admin.Succeed_Msg ("生成最近更新文章的HTML页完成!")
		Response.Write "<meta http-equiv=""refresh"" content=""2;url='Create_Listing.Asp'"">"
		Newasp.admin_footer
	End Sub

	Private Function NewArticleInfo(stype)
		Newasp.LoadTemplates ("article")
		Style_CSS = Replace(Replace(Newasp.Style_CSS, "{$SetupDir}", Newasp.SetupDir), "{$PicUrl}", Newasp.TempDir)
		HtmlTempStr = Newasp.mainhtml(0) & Newasp.mainhtml(1) & Newasp.mainhtml(2) & Newasp.mainhtml(3)
		HtmlTempStr = Replace(HtmlTempStr, "{$NavMenu}", Newasp.ClassMenu)
		HtmlTempStr = Replace(HtmlTempStr, "{$Style_CSS}", Style_CSS)
		Set Rs = Server.CreateObject("adodb.recordset")
		If stype <> "" Then
			SQL = "select top " & CInt(Newasp.TempSet(12)) & " * from NC_Article where isLock=0 and ArticleType='" & stype & "' order by InfoTime desc,ID desc"
			ArticleTypeSrt = stype
		Else
			SQL = "select top " & CInt(Newasp.TempSet(12)) & " * from NC_Article where isLock=0 order by InfoTime desc,ID desc"
			ArticleTypeSrt = "最近更新文章"
		End If
		NowStats = ArticleTypeSrt
		HtmlTitle = ArticleTypeSrt
		HtmlTempStr = HtmlTempStr & Newasp.temphtml(4)
		If CInt(Newasp.Setting(5)) = 0 Then
			HtmlTempStr = Replace(HtmlTempStr, "{$NewAllName}", "NewArticle.html")
		Else
			HtmlTempStr = Replace(HtmlTempStr, "{$NewAllName}", "NewArticle.Asp")
		End If
		Dim ArticleType, NewFileName
		ArticleType = Split(Newasp.Setting(36), ",")
		For i = 0 To UBound(ArticleType)
			HtmlTempStr = HtmlTempStr & Newasp.temphtml(5)
			If CInt(Newasp.Setting(5)) = 0 Then
				NewFileName = "NewArticle" & i & ".html"
			Else
				NewFileName = "?type=" & Trim(ArticleType(i))
			End If
			If Trim(ArticleType(i)) = stype Then HtmlTempStr = Replace(HtmlTempStr, "{$Selected}", "selected")
			HtmlTempStr = Replace(HtmlTempStr, "{$ArticleTypeName}", Trim(ArticleType(i)))

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?