木子屋 Dnawo's BLOG

新云修改：支持软件下载页生成HTML

👤 dnawo 📅 2008-03-10 👁 10055 👍 0 💬 0 🔄 本站原创
目前新云网站管理系统中软件模块的所有频道都不支持软件下载页生成HTML，经修改后目前可以实现软件下载页和下载信息页同步生成HTML，即生成内容HTML页的同时生成下载页HTML。下载页生成的规则为：生成路径同信息页生成路径；文件名为信息页文件名多加一个b，如信息页的文件名为soft20.html，则下载页文件名为soft20b.html。本次修改主要针对新云网站管理系统v3.1.0.1231，只需修改"inc/SoftChannel.asp"这个文件即可，下边为修改方法：

1.增加一私有变量HtmlContent2(红新新增，下同)
Private Rs, SQL, ChannelRootDir, HtmlContent, [color=Red]HtmlContent2,[/color]strIndexName

2.修改ReadSoftIntro函数，在生成生成内容HTML页后随即生成下载页HTML，下边为ReadSoftIntro函数部分内容：
If CreateHtml <> 0 And Pseudostatic = False Then
	Call CreateSoftIntro
Else
	ReadSoftIntro = HtmlContent
End If

[color=Red]'@@生成下载页 By dnawo 2008-03-09
If CreateHtml <> 0 And Pseudostatic = False Then
	Newasp.LoadTemplates ChannelID, 6, skinid
	HtmlContent2 = Newasp.HtmlContent
	
	HtmlContent2 = Replace(HtmlContent2, "{$ChannelRootDir}", ChannelRootDir)
	HtmlContent2 = Replace(HtmlContent2, "{$InstallDir}", strInstallDir)
	HtmlContent2 = Replace(HtmlContent2, "{$ChannelID}", ChannelID)
	HtmlContent2 = Replace(HtmlContent2, "{$ModuleName}", Newasp.ModuleName)
	HtmlContent2 = Replace(HtmlContent2, "{$SoftIndex}", strIndexName)
	HtmlContent2 = Replace(HtmlContent2, "{$IndexTitle}", strIndexName)
	
	HtmlContent2 = Replace(HtmlContent2, "{$PageTitle}", SoftName)
	HtmlContent2 = Replace(HtmlContent2, "{$SoftID}", softid)
	HtmlContent2 = Replace(HtmlContent2, "{$softid}", softid)
	HtmlContent2 = Replace(HtmlContent2, "{$ClassID}", classid)
	HtmlContent2 = Replace(HtmlContent2, "{$ClassName}", Rs("ClassName"))
	'HtmlContent2 = Replace(HtmlContent2, "{$strClassName}", m_strClassURL)
	Dim HtmlFileName
	HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("softid"),1,"")
	HtmlContent2 = Replace(HtmlContent2, "{$strUrl}", Right(HtmlFileName,Len(HtmlFileName)-InstrRev(HtmlFileName,"/")))
	HtmlContent2 = Replace(HtmlContent2, "{$Updatetime}",  Rs("SoftTime")&"")
	HtmlContent2 = Replace(HtmlContent2, "{$SoftSize}", ReadSoftsize(Rs("SoftSize")))
	HtmlContent2 = Replace(HtmlContent2, "{$FileSize}", CCur(Rs("SoftSize")))
	HtmlContent2 = Replace(HtmlContent2, "{$AllHits}", Rs("AllHits"))
	HtmlContent2 = Replace(HtmlContent2, "{$ShowDownAddress}", ShowDownAddress2(Rs("softid")))
	HtmlContent2 = Replace(HtmlContent2, "{$ShowDownUrl}", "")
	HtmlContent2 = Replace(HtmlContent2, "{$Description}", Newasp.CutString(SoftIntro,180))
	HtmlContent2 = Replace(HtmlContent2, "{$BackAndNextSoft}", "")
	
	HtmlContent2 = Replace(HtmlContent2, "{$HeaderTitle}", HeaderTitle)
	HtmlContent2 = Replace(HtmlContent2, "{$HeaderTitles}", HeaderTitles)
	HtmlContent2 = ReadClassMenu(HtmlContent2)
	HtmlContent2 = ReadClassMenubar(HtmlContent2)
	HtmlContent2 = HTML.ReadAnnounceList(HtmlContent2)
	HtmlContent2 = HTML.ReadStatistic(HtmlContent2)
	HtmlContent2 = HTML.ReadUserRank(HtmlContent2)
	RandomCodes = GetRandomizeCode
	'-- 新增分类广告代码
	HtmlContent2 = AdsReplace(HtmlContent2,  Rs("AdsCode") & "", Rs("stopad"))
	HtmlContent2 = Replace(HtmlContent2, "{$RandomCodes}", RandomCodes)
	HtmlContent2 = Replace(HtmlContent2, "{$SkinPath}", Newasp.SkinPath)
	HtmlContent2 = Replace(HtmlContent2,"{$InstallDir}", Newasp.InstallDir)
	HtmlContent2 = Replace(HtmlContent2, "{$SoftName}", SoftName)
	HtmlContent2 = Replace(HtmlContent2, "{$SubTitle}", subtitle)
	HtmlContent2 = Replace(HtmlContent2, "{$SoftContent}", SoftIntro)
	
	Call CreateSoftDown
End If[/color]

Rs.Close: Set Rs = Nothing

3.增加一个函数CreateSoftDown，用于生成软件下载页HTML：
'=================================================
'函数名：CreateSoftDown
'作  用：生成软件下载内容
'=================================================
Private Sub CreateSoftDown()
	Dim HtmlFileName
	HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("softid"),1,"")
	HtmlFilePath = Newasp.HtmlFilesPath
	Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
	Dim dot,LeftStr,RightStr
	dot = InstrRev(HtmlFileName,".")
	LeftStr = Left(HtmlFileName,dot-1)
	RightStr = Right(HtmlFileName,Len(HtmlFileName)-dot)
	HtmlFileName = LeftStr & "b." & RightStr
	'Response.Write(HtmlFileName)
	'Response.End()
	Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent2
	Response.Flush
End Sub

4.增加一个函数ShowDownAddress2，用于生成软件下载地址：
'================================================
'函数名：ShowDownAddress2
'作  用：显示软件下载地址
'参  数：SoftID ----软件ID
'================================================
Private Function ShowDownAddress2(softid)
	Dim rsAddress, sqlAddress, rsDown
	Dim DownText,showdown
	Dim DownloadName, DownloadPath
	Dim DownAddress,selfont,ii,foundstr,n
	Dim ShowDownUrl,softname

	On Error Resume Next
	showdown = Newasp.ChkNumeric(Newasp.HtmlSetting(1))
	If Newasp.CheckNull(Rs("SoftVer")) Then
		softname = Trim(Rs("SoftName") & " " & Rs("SoftVer"))
	Else
		softname = Trim(Rs("SoftName"))
	End If
	If Rs("PauseDown") > 0 Then
		ShowDownAddress2 = Newasp.HtmlSetting(22)
		Exit Function
	End If
	If IsRandomAddress Then
		If IsSqlDataBase = 1 Then
			foundstr = " orDER BY IsOuter DESC,newid()"
		Else
			foundstr = " orDER BY IsOuter DESC,rnd(A.downid)"
		End If
	Else
		foundstr = " orDER BY orders ASC"
	End If
	ii = 0
	n = 0
	Set rsDown = Newasp.Execute("Select id,downid,DownFileName,DownText FROM [NC_DownAddress] Where softid=" & CLng(softid))
	If Not (rsDown.BOF And rsDown.EOF) Then
		Do While Not rsDown.EOF
			ii = ii + 1
			DownText = rsDown("DownText") & ""
			If Len(DownText) = 0 Then DownText = "立即下载"
			If InStr(DownText, "{$") > 0 Then
				DownAddress = DownText
			Else
				'---- 如果使用了下载服务器,就打开下载服务器数据表
				If rsDown("downid") > 0 Then
					sqlAddress = "Select downid,DownloadName,DownloadPath,IsDisp,DownPoint,UserGroup,IsOuter,selfont FROM NC_DownServer Where ChannelID=" & ChannelID & " And depth=1 And rootid =" & rsDown("downid") & " And isLock=0 " & foundstr
					Set rsAddress = Newasp.Execute(sqlAddress)
					If rsAddress.EOF And rsAddress.BOF Then
						DownloadPath = ""
						DownloadName = ""
					Else
						Do While Not rsAddress.EOF
							DownAddress = DownAddress & Newasp.HtmlSetting(3)
							'---- 是否直接显示软件直接的下载地址
							If rsAddress("IsDisp") <> 1 Then
								DownloadPath = "download.asp?softid=" & softid & "&downid=" & rsAddress("downid") & "&id=" & rsDown(0)
							Else
								If rsAddress("IsOuter") <> 1 Then
									DownloadPath = Trim(rsAddress("DownloadPath") & rsDown(2))
								Else
									DownloadPath = Trim(rsAddress("DownloadPath"))
								End If
							End If
							ShowDownUrl = DownloadPath
							selfont = rsAddress("selfont") & ""
							If InStr(DownText, "###") > 0 Then
								DownloadName = Replace(rsAddress("DownloadName"), "{$SoftName}", DownText)
								DownloadName = Replace(DownloadName, "{$Soft_Name}", DownText)
								DownloadName = Replace(DownloadName, "###", "")
								DownAddress = Replace(DownAddress, "{$Soft_Name}", DownText)
								DownAddress = Replace(DownAddress, "{$show}", 1)
								DownAddress = Replace(DownAddress, "{$Title}", DownText)
							Else
								DownloadName = rsAddress("DownloadName") & ""
								DownloadName = Replace(DownloadName, "{$Soft_Name}", "")
								DownAddress = Replace(DownAddress, "{$Soft_Name}", "")
								DownAddress = Replace(DownAddress, "{$show}", 0)
								DownAddress = Replace(DownAddress, "{$Title}", SoftName)
							End If
							If Len(selfont) > 8 Then
								DownloadName = "<span " & selfont & ">" & DownloadName & "</span>"
							End If
							If rsAddress("UserGroup") > 0 Then
								DownloadName = Replace(DownloadName, "{$DownPoint}", rsAddress("DownPoint"))
							Else
								DownloadName = Replace(DownloadName, "{$DownPoint}", 0)
							End If
							DownloadName = Replace(DownloadName, "{$DownText}", DownText)
							DownloadName = Replace(DownloadName, "{$SoftName}", SoftName)
							DownAddress = Replace(DownAddress, "{$ii}", ii)
							DownAddress = Replace(DownAddress, "{$downid}", rsAddress("downid"))
							DownAddress = Replace(DownAddress, "{$DownLoadUrl}", DownloadPath)
							DownAddress = Replace(DownAddress, "{$DownLoadName}", DownloadName)
							DownAddress = Replace(DownAddress, "{$Number}", n)
							DownAddress = Replace(DownAddress, "###", "")
							rsAddress.MoveNext
							ii = ii + 1
							n = n + 1
						Loop
					End If
					Set rsAddress = Nothing
				Else
					DownAddress = DownAddress & Newasp.HtmlSetting(3)
					If showdown > 0 Then
						DownloadPath = Trim(rsDown("DownFileName") & "")
					Else
						DownloadPath = "download.asp?softid=" & softid & "&downid=0&id=" & rsDown(0)
					End If
					ShowDownUrl = DownloadPath
					DownAddress = Replace(DownAddress, "{$ii}", ii)
					DownAddress = Replace(DownAddress, "{$downid}", 0)
					DownAddress = Replace(DownAddress, "{$Soft_Name}", "")
					DownAddress = Replace(DownAddress, "{$Title}", SoftName)
					DownAddress = Replace(DownAddress, "{$DownLoadUrl}", DownloadPath)
					DownAddress = Replace(DownAddress, "{$DownLoadName}", DownText)
					DownAddress = Replace(DownAddress, "{$Number}", n)
					DownAddress = Replace(DownAddress, "###", "")
					DownAddress = Replace(DownAddress, "{$show}", 2)
					n = n + 1
				End If
			End If
			rsDown.MoveNext
		Loop
	End If
	Set rsDown = Nothing
	DownAddress = Replace(DownAddress, "{$SoftName}", SoftName)
	DownAddress = Replace(DownAddress, "{$ChannelRootDir}", ChannelRootDir)
	DownAddress = Replace(DownAddress, "{$InstallDir}", strInstallDir)
	DownAddress = Replace(DownAddress, "{$WebSiteUrl}", Newasp.SiteUrl)
	ShowDownAddress2 = DownAddress
End Function

5.修改ShowDownAddress函数，将原先动态的下载页地址改为静态地址，下边为ShowDownAddress函数部分内容：
Else
	SoftNameStr = Trim(Rs("SoftName") & " " & Rs("SoftVer"))
'			If IsURLRewrite Then
'				strDownAddress = ChannelRootDir & "dl" & Newasp.Supplemental(softid,6) & Newasp.HtmlExtName
'			Else
'				strDownAddress = ChannelRootDir & "softdown.asp?softid=" & softid
'			End If
	[color=Red]strDownAddress = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("softid"),1,"")
	Dim dot,LeftStr,RightStr
	dot = InstrRev(strDownAddress,".")
	LeftStr = Left(strDownAddress,dot-1)
	RightStr = Right(strDownAddress,Len(strDownAddress)-dot)
	strDownAddress = LeftStr & "b." & RightStr[/color]
	
	DownAddress = Newasp.HtmlSetting(27)			
	DownAddress = Replace(DownAddress, "{$ii}", 0)
	DownAddress = Replace(DownAddress, "{$downid}", 0)
	DownAddress = Replace(DownAddress, "{$ChannelRootDir}", ChannelRootDir)
	DownAddress = Replace(DownAddress, "{$InstallDir}", Newasp.InstallDir)
	DownAddress = Replace(DownAddress, "{$SoftName}", SoftNameStr)
	DownAddress = Replace(DownAddress, "{$SoftID}", softid)
	DownAddress = Replace(DownAddress, "{$DownLoadUrl}", strDownAddress)
End If

评论（0）

暂无评论。

计算题
评论需审核通过后显示
← 上一篇 文章评级代码 下一篇 → 租房十要素