欢迎光临

木子屋

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

作者: dnawo

日期: 2008-03-10 03:07 PM

分类: 程序修改

内容: 目前新云网站管理系统中软件模块的所有频道都不支持软件下载页生成HTML，经修改后目前可以实现软件下载页和下载信息页同步生成HTML，即生成内容HTML页的同时生成下载页HTML。下载页生成的规则为：生成路径同信息页生成路径；文件名为信息页文件名多加一个b，如信息页的文件名为soft20.html，则下载页文件名为soft20b.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)
HtmlContent2 = Replace(HtmlContent2, "{}", strInstallDir)
HtmlContent2 = Replace(HtmlContent2, "{}", ChannelID)
HtmlContent2 = Replace(HtmlContent2, "{}", Newasp.ModuleName)
HtmlContent2 = Replace(HtmlContent2, "{}", strIndexName)
HtmlContent2 = Replace(HtmlContent2, "{}", strIndexName)

HtmlContent2 = Replace(HtmlContent2, "{}", SoftName)
HtmlContent2 = Replace(HtmlContent2, "{}", softid)
HtmlContent2 = Replace(HtmlContent2, "{}", softid)
HtmlContent2 = Replace(HtmlContent2, "{}", classid)
HtmlContent2 = Replace(HtmlContent2, "{}", Rs("ClassName"))
'HtmlContent2 = Replace(HtmlContent2, "{}", m_strClassURL)
Dim HtmlFileName
HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("softid"),1,"")
HtmlContent2 = Replace(HtmlContent2, "{}", Right(HtmlFileName,Len(HtmlFileName)-InstrRev(HtmlFileName,"/")))
HtmlContent2 = Replace(HtmlContent2, "{}", Rs("SoftTime")&"")
HtmlContent2 = Replace(HtmlContent2, "{}", ReadSoftsize(Rs("SoftSize")))
HtmlContent2 = Replace(HtmlContent2, "{}", CCur(Rs("SoftSize")))
HtmlContent2 = Replace(HtmlContent2, "{}", Rs("AllHits"))
HtmlContent2 = Replace(HtmlContent2, "{}", ShowDownAddress2(Rs("softid")))
HtmlContent2 = Replace(HtmlContent2, "{}", "")
HtmlContent2 = Replace(HtmlContent2, "{}", Newasp.CutString(SoftIntro,180))
HtmlContent2 = Replace(HtmlContent2, "{}", "")

HtmlContent2 = Replace(HtmlContent2, "{}", HeaderTitle)
HtmlContent2 = Replace(HtmlContent2, "{}", 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)
HtmlContent2 = Replace(HtmlContent2, "{}", Newasp.SkinPath)
HtmlContent2 = Replace(HtmlContent2,"{}", Newasp.InstallDir)
HtmlContent2 = Replace(HtmlContent2, "{}", SoftName)
HtmlContent2 = Replace(HtmlContent2, "{}", subtitle)
HtmlContent2 = Replace(HtmlContent2, "{}", SoftIntro)

Call CreateSoftDown
End If
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"), "{}", DownText)
DownloadName = Replace(DownloadName, "{}", DownText)
DownloadName = Replace(DownloadName, "###", "")
DownAddress = Replace(DownAddress, "{}", DownText)
DownAddress = Replace(DownAddress, "{}", 1)
DownAddress = Replace(DownAddress, "{}", DownText)
Else
DownloadName = rsAddress("DownloadName") & ""
DownloadName = Replace(DownloadName, "{}", "")
DownAddress = Replace(DownAddress, "{}", "")
DownAddress = Replace(DownAddress, "{}", 0)
DownAddress = Replace(DownAddress, "{}", SoftName)
End If
If Len(selfont) > 8 Then
DownloadName = "<span " & selfont & ">" & DownloadName & "</span>"
End If
If rsAddress("UserGroup") > 0 Then
DownloadName = Replace(DownloadName, "{}", rsAddress("DownPoint"))
Else
DownloadName = Replace(DownloadName, "{}", 0)
End If
DownloadName = Replace(DownloadName, "{}", DownText)
DownloadName = Replace(DownloadName, "{}", SoftName)
DownAddress = Replace(DownAddress, "{}", ii)
DownAddress = Replace(DownAddress, "{}", rsAddress("downid"))
DownAddress = Replace(DownAddress, "{}", DownloadPath)
DownAddress = Replace(DownAddress, "{}", DownloadName)
DownAddress = Replace(DownAddress, "{}", 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)
DownAddress = Replace(DownAddress, "{}", 0)
DownAddress = Replace(DownAddress, "{}", "")
DownAddress = Replace(DownAddress, "{}", SoftName)
DownAddress = Replace(DownAddress, "{}", DownloadPath)
DownAddress = Replace(DownAddress, "{}", DownText)
DownAddress = Replace(DownAddress, "{}", n)
DownAddress = Replace(DownAddress, "###", "")
DownAddress = Replace(DownAddress, "{}", 2)
n = n + 1
End If
End If
rsDown.MoveNext
Loop
End If
Set rsDown = Nothing
DownAddress = Replace(DownAddress, "{}", SoftName)
DownAddress = Replace(DownAddress, "{}", ChannelRootDir)
DownAddress = Replace(DownAddress, "{}", strInstallDir)
DownAddress = Replace(DownAddress, "{}", 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, "{}", 0)
DownAddress = Replace(DownAddress, "{}", 0)
DownAddress = Replace(DownAddress, "{}", ChannelRootDir)
DownAddress = Replace(DownAddress, "{}", Newasp.InstallDir)
DownAddress = Replace(DownAddress, "{}", SoftNameStr)
DownAddress = Replace(DownAddress, "{}", softid)
DownAddress = Replace(DownAddress, "{}", strDownAddress)
End If

+ 查看当前日志评论 (0)

登录

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.109 ms

返回

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

你没有权限发表评论

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.109 ms

返回

暂无评论

返回

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.172 ms

返回