powereasy.soft.asp

个人网站比较简短

'参  数：无
'=================================================
Private Function GetSearchResult(iChannelID)
    Dim sqlSearch, rsSearch, iCount, SoftNum, arrSoftID, strSearchResult, Content
    strSearchResult = ""
    arrSoftID = GetSearchResultIDArr(iChannelID)
    If arrSoftID = "" Then
        GetSearchResult = "<p align='center'><br><br>" & R_XmlText_Class("ShowSearch/NoFound", "没有或没有找到任何{$ChannelShortName}") & "<br><br></p>"
        Set rsSearch = Nothing
        Exit Function
    End If

    SoftNum = 1
    sqlSearch = "select S.ChannelID,S.SoftID,S.SoftName,S.SoftVersion,S.Author,S.UpdateTime,S.Hits,S.SoftIntro,C.ClassID,C.ClassName,C.ParentDir,C.ClassDir,C.ClassPurview from PE_Soft S left join PE_Class C on S.ClassID=C.ClassID where SoftID in (" & arrSoftID & ") order by SoftID desc"
    Set rsSearch = Server.CreateObject("ADODB.Recordset")
    rsSearch.Open sqlSearch, Conn, 1, 1
    Do While Not rsSearch.EOF
        If iChannelID = 0 Then
            If rsSearch("ChannelID") <> PrevChannelID Then
                Call GetChannel(rsSearch("ChannelID"))
                PrevChannelID = rsSearch("ChannelID")
            End If
        End If
        
        strSearchResult = strSearchResult & "<b>" & CStr(MaxPerPage * (CurrentPage - 1) + SoftNum) & ".</b> "
        
        strSearchResult = strSearchResult & "[<a class='LinkSearchResult' href='" & GetClassUrl(rsSearch("ParentDir"), rsSearch("ClassDir"), rsSearch("ClassID"), rsSearch("ClassPurview")) & "' target='_blank'>" & rsSearch("ClassName") & "</a>] "
        
        strSearchResult = strSearchResult & "<a class='LinkSearchResult' href='" & GetSoftUrl(rsSearch("ParentDir"), rsSearch("ClassDir"), rsSearch("UpdateTime"), rsSearch("SoftID")) & "' target='_blank'>"
        
        If strField = "SoftName" Then
            strSearchResult = strSearchResult & "<b>" & Replace(ReplaceText(rsSearch("SoftName"), 2) & "", "" & Keyword & "", "<font color=red>" & Keyword & "</font>") & "</b>"
        Else
            strSearchResult = strSearchResult & "<b>" & ReplaceText(rsSearch("SoftName"), 2) & "</b>"
        End If
        strSearchResult = strSearchResult & " " & rsSearch("SoftVersion")
        strSearchResult = strSearchResult & "</a>"
        If strField = "Author" Then
            strSearchResult = strSearchResult & "&nbsp;[" & Replace(rsSearch("Author") & "", "" & Keyword & "", "<font color=red>" & Keyword & "</font>") & "]"
        Else
            strSearchResult = strSearchResult & "&nbsp;[" & rsSearch("Author") & "]"
        End If
        strSearchResult = strSearchResult & "[" & FormatDateTime(rsSearch("UpdateTime"), 1) & "][" & rsSearch("Hits") & "]"
        strSearchResult = strSearchResult & "<br>"
        
        Content = Left(Replace(Replace(ReplaceText(nohtml(rsSearch("SoftIntro")), 1), ">", "&gt;"), "<", "&lt;"), SearchResult_ContentLenth)
        If strField = "Content" Then
            strSearchResult = strSearchResult & "<div style='padding:10px 20px'>" & Replace(Content, "" & Keyword & "", "<font color=red>" & Keyword & "</font>") & "……</div>"
        Else
            strSearchResult = strSearchResult & "<div style='padding:10px 20px'>" & Content & "……</div>"
        End If
        strSearchResult = strSearchResult & "<br>"
        SoftNum = SoftNum + 1
        rsSearch.MoveNext
    Loop
    rsSearch.Close
    Set rsSearch = Nothing
    GetSearchResult = strSearchResult
End Function

Public Function GetSearchResult2(iChannelID, strValue)   '得到自定义列表的版面设计的HTML代码
    Dim strCustom, strParameter
	strCustom = strValue
    regEx.Pattern = "【SearchResultList\((.*?)\)】([\s\S]*?)【\/SearchResultList】"
    Set Matches = regEx.Execute(strCustom)
    For Each Match In Matches
        strParameter = Replace(Match.SubMatches(0), Chr(34), " ")
        strCustom = PE_Replace(strCustom, Match.value, GetSearchResultLabel(strParameter, Match.SubMatches(1), iChannelID))
    Next
    GetSearchResult2 = strCustom
End Function

Private Function GetSearchResultLabel(strTemp, strList, iChannelID)
    Dim sqlSearch, rsSearch, iCount, SoftNum, arrSoftID, Content
    Dim arrTemp
    Dim strSoftPic, strPicTemp, arrPicTemp
    Dim ItemNum, arrClassID, IsHot, IsElite, Author, DateNum, OrderType, UsePage, OpenType, TitleLen, ContentLen
    Dim iCols, iColsHtml, iRows, iRowsHtml, iNumber
    Dim rsCustom, strCustomList, strLink
    Dim rsField, ArrField, iField
    
    iCount = 0
    strCustomList = ""
        
    If strTemp = "" Or strList = "" Then GetSearchResultLabel = "": Exit Function

    iCols = 1: iRows = 1: iColsHtml = "": iRowsHtml = ""
    regEx.Pattern = "【(Cols|Rows)=(\d{1,2})\s*(?:\||｜)(.+?)】"
    Set Matches = regEx.Execute(strList)
    For Each Match In Matches
        If LCase(Match.SubMatches(0)) = "cols" Then
            If Match.SubMatches(1) > 1 Then iCols = Match.SubMatches(1)
            iColsHtml = Match.SubMatches(2)
        ElseIf LCase(Match.SubMatches(0)) = "rows" Then
            If Match.SubMatches(1) > 1 Then iRows = Match.SubMatches(1)
            iRowsHtml = Match.SubMatches(2)
        End If
        strList = regEx.Replace(strList, "")
    Next
    
    arrTemp = Split(strTemp, ",")
    If UBound(arrTemp) <> 2 Then
        GetSearchResultLabel = "自定义列表标签：【SearchResultList(参数列表)】列表内容【/SearchResultList】的参数个数不对。请检查模板中的此标签。"
        Exit Function
    End If
    
    TitleLen = arrTemp(0)
    UsePage = arrTemp(1)
    ContentLen = arrTemp(2)
    
    arrSoftID = GetSearchResultIDArr(iChannelID)
    If arrSoftID = "" Then
        GetSearchResultLabel = "<p align='center'><br><br>" & R_XmlText_Class("ShowSearch/NoFound", "没有或没有找到任何{$ChannelShortName}") & "<br><br></p>"
        Set rsSearch = Nothing
        Exit Function
    End If
    
    Set rsField = Conn.Execute("select FieldName,LabelName from PE_Field where ChannelID=-2 or ChannelID=" & ChannelID & "")
    If Not (rsField.BOF And rsField.EOF) Then
        ArrField = rsField.getrows(-1)
    End If
    Set rsField = Nothing

    sqlSearch = "select S.ChannelID,S.SoftID,S.SoftName,S.SoftVersion,S.Author,S.SoftPicUrl,"
    If IsArray(ArrField) Then
        For iField = 0 To UBound(ArrField, 2)
            sqlSearch = sqlSearch & "S." & ArrField(0, iField) & ","
        Next
    End If
    sqlSearch = sqlSearch & "S.UpdateTime,S.DemoUrl,S.RegUrl,S.Hits,S.DayHits,S.InfoPoint,S.WeekHits,"
    sqlSearch = sqlSearch & "S.MonthHits,S.SoftLanguage,S.SoftType,S.SoftIntro,S.OperatingSystem,S.OnTop,S.Keyword,"
    sqlSearch = sqlSearch & "S.Elite,S.Stars,S.SoftSize,S.CopyrightType,S.DownloadUrl,C.ClassID,C.ClassName,C.ParentDir,"
    sqlSearch = sqlSearch & "C.ClassDir,C.ClassPurview,C.ReadMe from PE_Soft S left join PE_Class C on S.ClassID=C.ClassID where SoftID in (" & arrSoftID & ") order by SoftID desc"
    SoftNum = 1
    Set rsCustom = Server.CreateObject("ADODB.Recordset")
    rsCustom.Open sqlSearch, Conn, 1, 1
    Do While Not rsCustom.EOF
        If iChannelID = 0 Then
            If rsCustom("ChannelID") <> PrevChannelID Then
                Call GetChannel(rsCustom("ChannelID"))
                PrevChannelID = rsCustom("ChannelID")
            End If
        End If
        
        strTemp = strList

        iNumber = (CurrentPage - 1) * MaxPerPage + iCount + 1

        strTemp = PE_Replace(strTemp, "{$Number}", iNumber)
        strTemp = PE_Replace(strTemp, "{$ClassID}", rsCustom("ClassID"))
        strTemp = PE_Replace(strTemp, "{$ClassName}", rsCustom("ClassName"))
        strTemp = PE_Replace(strTemp, "{$ParentDir}", rsCustom("ParentDir"))
        strTemp = PE_Replace(strTemp, "{$ClassDir}", rsCustom("ClassDir"))
        strTemp = PE_Replace(strTemp, "{$Readme}", rsCustom("ReadMe"))
        If InStr(strTemp, "{$ClassUrl}") > 0 Then strTemp = PE_Replace(strTemp, "{$ClassUrl}", GetClassUrl(rsCustom("ParentDir"), rsCustom("ClassDir"), rsCustom("ClassID"), rsCustom("ClassPurview")))

        strLink = "<a href='" & GetSoftUrl(rsCustom("ParentDir"), rsCustom("ClassDir"), rsCustom("UpdateTime"), rsCustom("SoftID")) & "'>"
    
        If InStr(strTemp, "{$SoftUrl}") > 0 Then strTemp = Replace(strTemp, "{$SoftUrl}", GetSoftUrl(rsCustom("ParentDir"), rsCustom("ClassDir"), rsCustom("UpdateTime"), rsCustom("SoftID")))
        strTemp = PE_Replace(strTemp, "{$SoftID}", rsCustom("SoftID"))
        If TitleLen > 0 Then
            strTemp = Replace(strTemp, "{$SoftName}", Left(rsCustom("SoftName"), TitleLen))
        Else
            strTemp = Replace(strTemp, "{$SoftName}", rsCustom("SoftName"))
        End If
        strTemp = Replace(strTemp, "{$SoftNameOriginal}", rsCustom("SoftName"))
        strTemp = PE_Replace(strTemp, "{$SoftVersion}", strLink & rsCustom("SoftVersion") & "</a>")
        If InStr(strTemp, "{$SoftProperty}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftProperty}", GetPropertyPic(rsCustom("OnTop"), rsCustom("Elite")))
        strTemp = PE_Replace(strTemp, "{$SoftSize}", rsCustom("SoftSize"))
        If InStr(strTemp, "{$SoftSize_M}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftSize_M}", Round(rsCustom("SoftSize") / 1024, 2))
        strTemp = PE_Replace(strTemp, "{$Keyword}", GetKeywords(",", rsCustom("Keyword")))
        If InStr(strTemp, "{$UpdateDate}") > 0 Then strTemp = PE_Replace(strTemp, "{$UpdateDate}", FormatDateTime(rsCustom("UpdateTime"), 2))
        strTemp = PE_Replace(strTemp, "{$UpdateTime}", rsCustom("UpdateTime"))
        If InStr(strTemp, "{$CopyrightType}") > 0 Then strTemp = PE_Replace(strTemp, "{$CopyrightType}", PE_HTMLEncode(rsCustom("CopyrightType")))
        If InStr(strTemp, "{$Stars}") > 0 Then strTemp = PE_Replace(strTemp, "{$Stars}", GetStars(rsCustom("Stars")))
        If ContentLen > 0 Then
            If InStr(strTemp, "{$SoftIntro}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftIntro}", Left(nohtml(rsCustom("SoftIntro")), ContentLen))
        Else
            strTemp = PE_Replace(strTemp, "{$SoftIntro}", "")
        End If
        strTemp = PE_Replace(strTemp, "{$OperatingSystem}", rsCustom("OperatingSystem"))
        If InStr(strTemp, "{$SoftType}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftType}", PE_HTMLEncode(rsCustom("SoftType")))
        If InStr(strTemp, "{$SoftLanguage}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftLanguage}", PE_HTMLEncode(rsCustom("SoftLanguage")))
        strTemp = PE_Replace(strTemp, "{$Hits}", rsCustom("Hits"))
        strTemp = PE_Replace(strTemp, "{$DayHits}", rsCustom("DayHits"))
        strTemp = PE_Replace(strTemp, "{$WeekHits}", rsCustom("WeekHits"))
        strTemp = PE_Replace(strTemp, "{$MonthHits}", rsCustom("MonthHits"))
        strTemp = PE_Replace(strTemp, "{$Author}", rsCustom("Author"))
        If InStr(strTemp, "{$InfoPoint}") > 0 Then strTemp = PE_Replace(strTemp, "{$InfoPoint}", GetInfoPoint(rsCustom("InfoPoint")))
        If InStr(strTemp, "{$SoftPoint}") > 0 Then strTemp = PE_Replace(strTemp, "{$SoftPoint}", GetInfoPoint(rsCustom("InfoPoint")))
        strTemp = PE_Replace(strTemp, "{$SoftAuthor}", rsCustom("Author"))
        strTemp = PE_Replace(strTemp, "{$AuthorEmail}", "")
        strTemp = PE_Replace(strTemp, "{$DemoUrl}", rsCustom("DemoUrl"))
        strTemp = PE_Replace(strTemp, "{$RegUrl}", rsCustom("RegUrl"))
        
        'strTemp = PE_Replace(strTemp, "{$DownloadUrl}", Mid(rsCustom("DownloadUrl"), InStr(rsCustom("DownloadUrl"),"|")))
        '替换下载图片
        regEx.Pattern = "\{\$SoftPic\((.*?)\)\}"
        Set Matches = regEx.Execute(strTemp)
        For Each Match In Matches
            arrPicTemp = Split(Match.SubMatches(0), ",")
            strSoftPic = GetSoftPicUrl(Trim(rsCustom("SoftPicUrl")), PE_CLng(arrPicTemp(0)), PE_CLng(arrPicTemp(1)))
            strTemp = Replace(strTemp, Match.value, strSoftPic)
        Next
        
        If IsArray(ArrField) Then
            For iField = 0 To UBound(ArrField, 2)
                strTemp = PE_Replace(strTemp, ArrField(1, iField), PE_HTMLEncode(rsCustom(Trim(ArrField(0, iField)))))
            Next
        End If

        strCustomList = strCustomList & strTemp
        rsCustom.MoveNext
        iCount = iCount + 1
        If iCols > 1 And iCount Mod iCols = 0 Then strCustomList = strCustomList & iColsHtml
        If iRows > 1 And iCount Mod iCols * iRows = 0 Then strCustomList = strCustomList & iRowsHtml
        If iCount >= MaxPerPage Then Exit Do
    Loop
    rsCustom.Close
    Set rsCustom = Nothing
    
    GetSearchResultLabel = strCustomList
End Function

'=================================================
'函数名：GetCorrelative
'作  用：显示相关下载
'参  数：SoftNum  ----最多显示多少个下载
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'        OrderType ---- 排序方式，1--按软件ID降序，2--按软件ID升序，3--按更新时间降序，4--按更新时间升序，5--按点击数降序，6--按点击数升序，7--按评论数降序，8--按评论数升序
'        OpenType ---- 软件打开方式，0为在原窗口打开，1为在新窗口打开
'        Cols ---- 每行的列数。超过此列数就换行。
'=================================================
Private Function GetCorrelative(SoftNum, TitleLen, OrderType, OpenType, Cols)
    Dim rsCorrelative, sqlCorrelative, strCorrelative, strSoftTitle, iCols, iTemp
    Dim strKey, arrKey, i, MaxNum
    iTemp = 1
    If PE_CLng(Cols) <> 0 Then
        iCols = PE_CLng(Cols)
    Else
        iCols = 1
    End If

    If SoftNum > 0 And SoftNum <= 100 Then
        sqlCorrelative = "select top " & SoftNum
    Else
        sqlCorrelative = "Select Top 5 "
    End If
    strKey = Mid(rsSoft("Keyword")