程序修改

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

编辑:dnawo 日期:2008-03-10

字体大小: 小中大

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

发表评论

请登录后再发表评论！

Powered By PJBlog3 V3.2.9.518 CopyRight 2005 - 2021, 木子屋 xhtml | css
Processed in 0.734375 second(s) , 6 queries , Simple Yellow Design By ChangHua(FatMouse) 闽ICP备19016051号-1

01.w3school	02.51Windows
03.ES6入门教程	04.PHP中文手册
05.MSDN\|.NET	06.Visual Studio\|O
07.ASP.NET MVC2	08.ASP.NET MVC3
09.jQuery\|D\|P	10.Vue.js
11.AspNetPager	12.SharpZipLib
13.AjaxPro	14.Json.NET
15.Web Services	16.BaiDu API
17.数据堂	18.纯真IP库
19.SharpDevelop	20.动软
21..NET Reflector	22.百度\|高德[坐标]
23.Layui\|G\|X\|Q	24.Ele\|uni-app
25.SourceForge	26.CodeProject
27.Dynamic Drive	28.CodePlex
29.GitHub	30.Gitee
31.IItellYou	32.面包多
33.一门APP	34.友盟数据
35.JSON格式化	36.在线文本比较
37.微软开发者中心	38.Android开发者中心

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

编辑:dnawo 日期:2008-03-10

Category

IM Online

User Panel

Search

Recent Comments

最新评论

Resources