create_articlecls.asp

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

<%
Class Create_Article_Cls
	Private ErrMsg
	Private SucMsg
	Private Founderr
	Private NC_Admin, Rs, SQL
	Private ArticleID, classid, rootid, depth, ClassName, ParentID, strParent, Child
	Private NewCloud_Ads
	Private action, d, p
	Private ArticleTotal
	Private ArticleNumber
	Private totalnumber
	Private maxperpage
	Private datDate
	Private TotalPage
	Private startime
	Private Rs1, i, j
	Private ArticleTypeSrt
	Private NowStats
	Private HtmlTitle
	Private Style_CSS
	Private HtmlTempStr
	Private FileName
	Private Title, InfoTime
	Private stype, ArtType, ii
	Private showpage
	Private TempString
	Private HtmlTemplate
	Private CurrentPage
	Private bookmark
	Private tempPcount

	Private Sub Class_Initialize()
		Founderr = False
		Set Rs = Server.CreateObject("ADODB.Recordset")
		d = Timer()
		Set NewCloud_Ads = New Adcolumn_Cls
		Newasp.LoadTemplates ("article")
	End Sub

	Private Sub Class_Terminate()
		If IsObject(Conn) Then
			Conn.Close
			Set Conn = Nothing
		End If
		Set NewCloud_Ads = Nothing
	End Sub

	Public Sub Init_CreateHtml()
		Set NC_Admin = New Check
		Server.ScriptTimeout = 99999
		NC_Admin.AdminChk = "35"
		NC_Admin.Check
		If CInt(Newasp.Setting(5)) = 1 Then
			NC_Admin.Error_Msg ("对不起!你选择动态ASP程序,不能生成HTML文件,请在基本设置修改成静态HTML方能生成THML文件。")
			Exit Sub
		End If
		Newasp.admin_header
		action = Trim(Request("action"))
		Select Case action
			Case "Create"
				Call CreateArticleHtml
			Case "update"
				Call UpdateAllArticle
			Case Else
				Call CreateMain
		End Select
		Newasp.admin_footer
	End Sub

	Public Sub GetArticle()
		If CInt(Newasp.Setting(5)) = 0 Then Response.Redirect (Newasp.SetupDir & Newasp.Setting(6))
		If Not IsNumeric(Request("id")) And Request("id") <> "" Then
			Response.Write "错误的系统参数!ID必须是数字"
			Response.End
		End If
		If Request("id") = "0" Or Request("id") = "" Then
			Response.Write "<BR><BR><BR>Sorry！错误的系统参数,请选择正确的连接方式。"
			Response.End
		Else
			ArticleID = CLng(Request("id"))
		End If
		Response.Write CreateArticle(ArticleID)
	End Sub

	Public Function CreateArticle(ArticleID)
		Dim Rs, SQL, HtmlTemplate
		Dim ClassName, classid, depth, ParentID, strParent
		Dim Topic, Content, InfoTime
		Dim Writer, Source, AllHits
		If Not IsNumeric(ArticleID) And ArticleID <> "" Then
			Response.Write "错误的系统参数!ID必须是数字"
			Response.End
		End If
		ArticleID = CLng(ArticleID)
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select * from NC_Article where isLock=0 and id = " & ArticleID
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			Response.Write = "<p align=center>还没有找到相关文章！</p>"
			Exit Function
		Else
			Topic = Rs("Title")
			Content = Rs("Content")
			InfoTime = Rs("InfoTime")
			Writer = Rs("Writer")
			Source = Rs("Source")
			AllHits = Rs("Hits")
			classid = Rs("classid")
		End If
		Rs.Close
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select classid,rootid,ClassName,depth,ParentID,strParent from [NC_Class] where classid = " & classid
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			Response.Write "Sorry！没有找到任何软件信息。或者您选择了错误的系统参数!"
			Exit Function
		Else
			ClassName = Rs("ClassName")
			classid = Rs("classid")
			depth = Rs("depth")
			ParentID = Rs("ParentID")
			strParent = Rs("strParent")
			CreateNewFolder (CLng(classid))
		End If
		Rs.Close
		Dim temphtml, NowStats, HtmlTitle, ArticleIndex
		Dim TempTopStr, TempFootStr, Style_CSS
		If CInt(Newasp.Setting(5)) = 0 Then
			ArticleIndex = "<A HREF='" & Newasp.SetupDir & "Article/index.html'>" & Newasp.TempSet(7) & "</A>→"
		Else
			ArticleIndex = "<A HREF='" & Newasp.SetupDir & "Article_Index.Asp'>" & Newasp.TempSet(7) & "</A>→"
		End If
		NowStats = ArticleIndex & NowStation(classid, ClassName, ParentID, strParent) & "→" & Topic
		HtmlTitle = Topic
		If Len(Newasp.temphtml(0)) < 50 Then
			TempTopStr = Newasp.mainhtml(0) & Newasp.mainhtml(1) & Newasp.mainhtml(2) & Newasp.mainhtml(3)
		Else
			TempTopStr = Newasp.temphtml(0)
		End If
		If Len(Newasp.temphtml(3)) = 0 Then
			TempFootStr = Newasp.mainhtml(4)
		Else
			TempFootStr = Newasp.temphtml(3)
		End If
		temphtml = TempTopStr & Newasp.temphtml(1) & Newasp.temphtml(2) & Newasp.temphtml(3) & TempFootStr
		If CInt(Newasp.Setting(5)) = 0 Then
			temphtml = Replace(temphtml, "{$TopMeun}", Newasp.mainset(9))
		Else
			temphtml = Replace(temphtml, "{$TopMeun}", Newasp.mainset(10))
		End If
		temphtml = Replace(temphtml, "{$Width}", Newasp.mainset(0))
		temphtml = Replace(temphtml, "{$FootMeun}", Newasp.mainset(11))
		temphtml = Replace(temphtml, "{$NavMenu}", Newasp.ClassMenu)
		temphtml = Replace(temphtml, "{$Style_CSS}", Newasp.Style_CSS)
		temphtml = Replace(temphtml, "{$NowStats}", NowStats)
		temphtml = Replace(temphtml, "{$Title}", HtmlTitle)
		temphtml = Replace(temphtml, "{$ClassID}", classid)
		temphtml = Replace(temphtml, "{$ArticleID}", articleid)
		temphtml = Replace(temphtml, "{$Topic}", Topic)
		temphtml = Replace(temphtml, "{$Content}", Content)
		temphtml = Replace(temphtml, "{$InfoTime}", InfoTime)
		temphtml = Replace(temphtml, "{$AllHits}", AllHits)
		temphtml = Replace(temphtml, "{$Writer}", Writer)
		temphtml = Replace(temphtml, "{$Source}", Source)
		temphtml = Replace(temphtml, "{$HotArticle}", GetHotArticle)
		temphtml = Replace(temphtml, "{$KeyArticle}", GetKeyArticle(Topic, articleid))
		temphtml = Replace(temphtml, "{$FormerArticle}", FormerArticle(articleid))
		temphtml = Replace(temphtml, "{$NextArticle}", NextArticle(articleid))
		temphtml = Replace(temphtml, "{$ArticleEssay}", GetArticleEssay(articleid))
		temphtml = Replace(temphtml, "{$Adcolumn(0)}", NewCloud_Ads.RunScriptAds(6))
		temphtml = Replace(temphtml, "{$Adcolumn(1)}", NewCloud_Ads.BannerAds(6))
		temphtml = Replace(temphtml, "{$Adcolumn(2)}", NewCloud_Ads.AdsColumn(6, 2))
		temphtml = Replace(temphtml, "{$Adcolumn(3)}", NewCloud_Ads.AdsColumn(6, 3))
		temphtml = Replace(temphtml, "{$Adcolumn(6)}", NewCloud_Ads.AdsColumn(6, 7))
		temphtml = Replace(temphtml, "{$Adcolumn(4)}", NewCloud_Ads.ScriptFloatAds(6))
		temphtml = Replace(temphtml, "{$Adcolumn(5)}", NewCloud_Ads.ScriptFixedAds(6))
		HtmlTemplate = temphtml
		Set Rs = Nothing
		If CInt(Newasp.Setting(5)) = 0 Then
			CreateHtmlFile classid, articleid, HtmlTemplate
		Else
			CreateArticle = HtmlTemplate
		End If
	End Function
	'*************************************************************
	'函数作用：生成HTML文件
	'*************************************************************
	Private Function CreateHtmlFile(classid, articleid, HtmlTemplate)
		Dim CreateHtml, FSO, Fout, CreatePath
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		CreatePath = "" & Newasp.SetupDir & "Article/Catalog" & classid & "/" & articleid & ".html"
		CreateHtml = Server.MapPath(CreatePath)
		Set Fout = FSO.CreateTextFile(CreateHtml)
		Fout.WriteLine HtmlTemplate
		Fout.Close
		Set Fout = Nothing
		Set FSO = Nothing
	End Function
	'*************************************************************
	'函数作用：按分类ID生成文件目录
	'*************************************************************
	Private Function CreateNewFolder(FolderID)
		Dim FSO, FolderPath
		If CInt(Newasp.Setting(5)) = 1 Then Exit Function
		FolderPath = Newasp.SetupDir & "Article/Catalog" & FolderID
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		If FSO.FolderExists(Server.MapPath(FolderPath)) = False Then
			FSO.CreateFolder Server.MapPath(FolderPath)
		End If
		Set FSO = Nothing
	End Function
	'*************************************************************
	'函数作用：当前位置
	'*************************************************************
	Private Function NowStation(classid, ClassName, ParentID, strParent)
		Dim Rs, SQL, HtmlString
		Set Rs = Server.CreateObject("adodb.recordset")
		If ParentID <> 0 And Len(strParent) <> 0 Then
			SQL = "select classid,ClassName from [NC_Class] where classid in(" & strParent & ")"
			Rs.Open SQL, Conn, 1, 1
			If Not (Rs.EOF And Rs.bof) Then
				Do While Not Rs.EOF
					If CInt(Newasp.Setting(5)) = 0 Then
						HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing/Catalog" & Rs(0) & "/Listing_indate_Desc_1.html'>" & Rs(1) & "</a>→"
					Else
						HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing.Asp?classid=" & Rs(0) & "'>" & Rs(1) & "</a>→"
					End If
					Rs.movenext
				Loop
			End If
			Rs.Close
			Set Rs = Nothing
		End If
		If CInt(Newasp.Setting(5)) = 0 Then
			HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing/Catalog" & classid & "/Listing_indate_Desc_1.html'>" & ClassName & "</a>"
		Else
			HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing.Asp?classid=" & classid & "'>" & ClassName & "</a>"
		End If
		NowStation = HtmlString
	End Function
	'*************************************************************
	'函数作用：相关文章
	'*************************************************************
	Private Function GetKeyArticle(Keys, keyid)
		Dim Rss, SQL, HtmlString, Topic, InfoTime
		Set Rss = Server.CreateObject("adodb.recordset")
		SQL = "select top " & CInt(Newasp.TempSet(0)) & " id,classid,title,Hits,InfoTime from NC_Article where title like '%" & Left((Keys), 4) & "%' and  ID <> " & keyid
		Rss.Open SQL, Conn, 1, 1
		If Not (Rss.EOF And Rss.bof) Then
			Do While Not Rss.EOF
				HtmlString = HtmlString & Newasp.TempSet(2)
				If CInt(Newasp.Setting(5)) = 0 Then
					Topic = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rss("classid") & "/" & Rss("id") & ".html' title='文章标题: " & Rss("Title") & "<BR>更新时间: " & Rss("InfoTime") & "<BR>浏览次数: " & Rss("Hits") & "' class='TableLink'>" & Newasp.gotTopic(Rss("Title"), CInt(Newasp.TempSet(1))) & "</A>"
				Else
					Topic = "<A HREF='" & Newasp.SetupDir & "Article.asp?id=" & Rss("id") & "' title='文章标题: " & Rss("Title") & "<BR>更新时间: " & Rss("InfoTime") & "<BR>浏览次数: " & Rss("Hits") & "' class='TableLink'>" & Newasp.gotTopic(Rss("Title"), CInt(Newasp.TempSet(1))) & "</A>"
				End If
				InfoTime = Month(Rss("InfoTime")) & "/" & Day(Rss("InfoTime"))
				HtmlString = Replace(HtmlString, "{$Hits}", Rss("Hits"))
				HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
				HtmlString = Replace(HtmlString, "{$Topic}", Topic)
				Rss.movenext
			Loop
		End If
		Rss.Close
		Set Rss = Nothing
		GetKeyArticle = HtmlString
	End Function
	'*************************************************************
	'函数作用：文章评论信息
	'*************************************************************
	Private Function GetArticleEssay(articleid)
		Dim Rss
		Dim SQL
		Dim HtmlString
		Set Rss = CreateObject("adodb.recordset")
		SQL = "select top " & CInt(Newasp.TempSet(8)) & " * from NC_ArticleEssay where ArticleID=" & articleid & " order by ID desc"
		Rss.Open SQL, Conn, 1, 1
		If Rss.bof And Rss.EOF Then
			HtmlString = ""
		Else
			Do While Not Rss.EOF
				HtmlString = HtmlString & "用户名：" & Rss("username") & " 　参与时间：" & Rss("postime") & "<BR>"
				HtmlString = HtmlString & "　 · " & Newasp.gotTopic(Rss("content"), CInt(Newasp.TempSet(9))) & "<BR>"
				Rss.movenext
			Loop
		End If
		Rss.Close
		Set Rss = Nothing
		GetArticleEssay = HtmlString
	End Function

	Private Function FormerArticle(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)