⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 powereasy.supply.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 4 页
字号:
        End If
    ElseIf SpecialID > 0 Then
        QuerySql = QuerySql & "And A.SpecialId=" & SpecialID
    End If
   
    Select Case CommandType
        Case 1
            QuerySql = QuerySql & "And A.CommandType=" & CommandType & " And DateDiff(" & PE_DatePart_D & ",A.UpdateTime," & PE_Now & ") < A.CommandChannelDays "
        Case 2
            QuerySql = QuerySql & "And A.CommandType=" & CommandType & " And DateDiff(" & PE_DatePart_D & ",A.UpdateTime," & PE_Now & ") < A.CommandClassDays "
        Case 3
            QuerySql = QuerySql & "And A.CommandType<>0"
    End Select
    If IsNew Then
        QuerySql = QuerySql & " And DateDiff(" & PE_DatePart_D & "," & PE_Now & ",A.UpdateTime)< " & DaysOfNew & ""
    End If

    If IsHot Then
        QuerySql = QuerySql & " And Hits >= " & HitsOfHot & ""
    End If
    If SupplyType >= 0 Then
        QuerySql = QuerySql & " And  SupplyType = " & SupplyType & ""
    End If

    If CurrentPage > 1 Then
        QuerySql = QuerySql & " and A.SupplyID < (select min(SupplyId) from (select top " & ((CurrentPage - 1) * MaxShowInfo) & " A.SupplyId " & QuerySql & " order by A.SupplyId desc) as QueryArticle) "
    End If
    strSql = "Select Top " & MaxShowInfo & " A.SupplyId,A.ClassId,A.SupplyTitle,A.SupplyName,A.SupplyType,"
    strSql = strSql & "A.TradeType,A.SupplyPicUrl,A.UpDateTime,B.Country,B.Province,B.City "
    
    strSql = strSql & QuerySql & " order by A.SupplyId desc "
    GetExecuteSql = strSql
End Function

'*****************************
'获得多列式信息列表
'ClassId --- 分类
'CommandType --- 推荐类型
'iCols--每行显示几条
'iLength--每条信息显示多长
'IsNew  ---- 是否显示最新信息
'刘永涛
'2005-12-21
'****************************************
Private Function getInfoList(PageType, ClassID, CommandType, iCols, iLength, IsNew, IsHot, iWeight, iHeight, ShowNum, SupplyType, ShowInfoType)
    Dim strTable, strTemp, Rows, rsSupply, strSql
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    strSql = GetExecuteSql(PageType, ClassID, CommandType, IsNew, IsHot, ShowNum, SupplyType, False)
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getInfoList = "<li>没有任何信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            Rows = Rows + 1
            strTemp = strTemp & "<td><Img src='" & ChannelUrl & "/Images/article_common.gif' border=0/>"
            If ShowInfoType Then
                strTemp = strTemp & "<a href='" & ChannelUrl & "/Search.asp?SupplyType=" & rsSupply("SupplyType") & "&SearchType=0'><font color=red>[" & GetSupplyInfoType(rsSupply("SupplyType"), "//SupplyType/Type") & "]</font></a>"
            End If
            strTemp = strTemp & "<a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target ='_self' "
            Else
                strTemp = strTemp & " target = '_blank' "
            End If
            strTemp = strTemp & ">"
            strTemp = strTemp & Left(rsSupply("SupplyTitle"), iLength) & "</a></td>" & vbCrLf
            If (Rows Mod iCols) = 0 Then
                strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
                strTemp = ""
            End If
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
    getInfoList = "<Table Width='100%'>" & strTable & "</Table>"
End Function

Private Function getHotSupplyInfo(ByVal iCols, ByVal iLength, ByVal ShowNum)
    Dim strSql, strTable, strTemp, Rows, rsSupply
    strSql = "Select Top " & ShowNum & " SupplyID,SupplyTitle From PE_Supply Where Hits >= " & HitsOfHot & " And Deleted=" & PE_False & " And Status=1 Order By SupplyID DESC"
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getHotSupplyInfo = "<li>没有热点信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            Rows = Rows + 1
            strTemp = strTemp & "<td><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target = '_self' "
            Else
                strTemp = strTemp & " target = '_blank' "
            End If

            strTemp = strTemp & ">"
            strTemp = strTemp & Left(rsSupply("SupplyTitle"), iLength) & "</a></td>" & vbCrLf
            If (Rows Mod iCols) = 0 Then
                strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
                strTemp = ""
            End If
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
    getHotSupplyInfo = "<Table Width='100%'>" & strTable & "</Table>"
End Function

Private Function getCommandSupplyInfo(ByVal CommandType, ByVal iCols, ByVal iLength, ByVal ShowNum)
    Dim strSql, strTable, strTemp, Rows, rsSupply, QuerySql
    Select Case CommandType
        Case 1
            QuerySql = "CommandType=" & CommandType & " And DateDiff(" & PE_DatePart_D & ",UpdateTime," & PE_Now & ") < CommandChannelDays "
        Case 2
            QuerySql = "CommandType=" & CommandType & " And DateDiff(" & PE_DatePart_D & ",UpdateTime," & PE_Now & ") < CommandClassDays "
        Case Else
            QuerySql = "CommandType<>0"
    End Select
    strSql = "Select Top " & ShowNum & " SupplyId,SupplyTitle From PE_Supply Where " & QuerySql & " And Deleted=" & PE_False & " And Status=1 Order By SupplyId DESC"
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getCommandSupplyInfo = "<li>没有推荐信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            Rows = Rows + 1
            strTemp = strTemp & "<td><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target = '_self' "
            Else
                strTemp = strTemp & " target ='_blank' "
            End If
            strTemp = strTemp & ">"
            strTemp = strTemp & Left(rsSupply("SupplyTitle"), iLength) & "</a></td>" & vbCrLf
            If (Rows Mod iCols) = 0 Then
                strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
                strTemp = ""
            End If
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
    getCommandSupplyInfo = "<Table Width='100%'>" & strTable & "</Table>"
End Function

Private Function getLasterSupplyInfo(ByVal iCols, ByVal iLength, ByVal ShowNum)
    Dim strSql, strTable, strTemp, Rows, rsSupply
    strSql = "Select Top " & ShowNum & " SupplyId,SupplyTitle From PE_Supply Where DateDiff(" & PE_DatePart_D & "," & PE_Now & ",UpdateTime)< " & DaysOfNew & " And Deleted=" & PE_False & " And Status=1 Order by SupplyId DESC"
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getLasterSupplyInfo = "<li>没有最新信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            Rows = Rows + 1
            strTemp = strTemp & "<td Class='LasterStyle'><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target = '_self' "
            Else
                strTemp = strTemp & " target = '_blank' "
            End If
            strTemp = strTemp & ">"
            strTemp = strTemp & Left(rsSupply("SupplyTitle"), iLength) & "</a></td>" & vbCrLf
            If (Rows Mod iCols) = 0 Then
                strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
                strTemp = ""
            End If
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
    getLasterSupplyInfo = "<Table Width='100%'>" & strTable & "</Table>"
End Function
Private Function getPicLasterInfo(ByVal iCols, ByVal iLength, ByVal ShowNum, ByVal iWidth, ByVal iHeight)
    Dim strSql, rsSupply, Rows, strTemp, strTable, QuerySql
    If ClassID > 0 Then
        If Child > 0 Then
            QuerySql = " And ClassID in (" & arrChildID & ")"
        Else
            QuerySql = " And ClassID=" & ClassID
        End If
    ElseIf SpecialID > 0 Then
        QuerySql = "And SpecialId=" & SpecialID
    End If

    strSql = "Select Top " & ShowNum & " SupplyID,SupplyTitle,SupplyPicUrl From PE_Supply Where SupplyPicUrl<>'' And Deleted=" & PE_False & " And Status=1 And DateDiff(" & PE_DatePart_D & "," & PE_Now & ",UpdateTime)< " & DaysOfNew & " " & QuerySql & " Order By SupplyID"
   
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getPicLasterInfo = "<li>没有最新图片信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            Rows = Rows + 1
            strTemp = strTemp & "<Td><Table><tr><td><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target = '_self' "
            Else
                strTemp = strTemp & " target = '_blank' "
            End If
            strTemp = strTemp & ">"
            strTemp = strTemp & "<Img src=" & UploadDir & "/" & getDefaultPicUrl(rsSupply("SupplyPicUrl")) & " border='0 'width ='" & iWidth & "' height='" & iHeight & "' alt=" & rsSupply("SupplyTitle") & " /></a></td></tr><tr><td><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'>" & Left(rsSupply("SupplyTitle"), iLength) & "</a></td></tr></Table></td>"
            If (Rows Mod iCols) = 0 Then
                strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
                strTemp = ""
            End If
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    strTable = strTable & "<tr>" & strTemp & "</tr>" & vbCrLf
    getPicLasterInfo = "<Table Width='100%'>" & strTable & "</Table>"
End Function
'*******************************************
'获得图片信息列表样式
'ShowNum -----------每页显示的信息数
'CurrentPage -------当前页数
'KeyWords ----------关键字
'Flag --------------是否有分页
'iLength -----------标题长度
'iWidth  -----------图片的宽度
'iHeight -----------图片的高度
'******************************************
Private Function getListPicInfoList(ByVal PageType, ByVal ClassID, ByVal CommandType, ByVal iCols, ByVal iLength, ByVal IsNew, ByVal IsHot, ByVal iWidth, ByVal iHeight, ByVal ShowNum, ByVal SupplyType, ByVal ShowInfoType)
    Dim strSql, rsSupply, Rows, strTemp
    
    strSql = GetExecuteSql(PageType, ClassID, CommandType, IsNew, IsHot, ShowNum, SupplyType, True)
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    If rsSupply.EOF And rsSupply.BOF Then
        getListPicInfoList = "<li>没有图片信息!</li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            strTemp = strTemp & "<tr><td><a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'"
            If OpenType = 0 Then
                strTemp = strTemp & " target = '_self' "
            Else
                strTemp = strTemp & " target = '_blank' "
            End If
            strTemp = strTemp & "><img width =" & iWidth & " height=" & iHeight & " src=" & UploadDir & "/" & getDefaultPicUrl(rsSupply("SupplyPicUrl")) & " border=0 /></a></td><td>"
            If ShowInfoType Then
                strTemp = strTemp & "<a href='" & ChannelUrl & "/Search.asp?SupplyType=" & rsSupply("SupplyType") & "&SearchType=0'><font color=red>[" & GetSupplyInfoType(rsSupply("SupplyType"), "//SupplyType/Type") & "]</font></a>"
            End If
            strTemp = strTemp & "<a href='" & ChannelUrl & "/ShowSupply.asp?SupplyId=" & rsSupply("SupplyId") & "'>" & Left(rsSupply("SupplyTitle"), iLength) & "</a></td><td>" & rsSupply("Province") & "/" & rsSupply("City") & "</td><td>" & GetSupplyInfoType(rsSupply("TradeType"), "//TradeType/Type") & "</td></tr>"
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
   
    getListPicInfoList = "<Table Width='100%'>" & strTemp & "</Table>"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -