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

目前新云网站管理系统中软件模块的所有频道都不支持软件下载页生成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}", 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


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
    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


上一篇: 文章评级代码
下一篇: 租房十要素
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
最新日志:
评论: 0 | 引用: 0 | 查看次数: 8509
发表评论
登录后再发表评论!