新云2.1修改：支持软件下载页生成HTML
-
目前新云网站管理系统中软件模块的所有频道都不支持软件下载页生成HTML，经修改后目前可以实现软件下载页和下载信息页同步生成HTML，即生成内容HTML页的同时生成下载页HTML。本次修改主要针对新云网站管理系统v3.1.0.1231，只需修改"inc/SoftChannel.asp"这个文件即可，下边为修改方法：
1.增加一私有变量HtmlContent2(红新新增，下同)
Private Rs, SQL, ChannelRootDir, HtmlContent, HtmlContent2,strIndexName
2.修改ReadSoftIntro函数，在生成生成内容HTML页后随即生成下载页HTML，下边为ReadSoftIntro函数部分内容：
If CreateHtml <> 0 And Pseudostatic = False Then
Call CreateSoftIntro
Else
ReadSoftIntro = HtmlContent
End If'@@生成下载页 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 IfRs.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 Sub4.增加一个函数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,softnameOn 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
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
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
