powereasy.supply.asp

个人网站比较简短

End Function
Private Function getDefaultPicUrl(ByVal PicUrl)
    Dim arrPicUrl
    If Not (IsNull(PicUrl)) Or PicUrl <> "" Then
        arrPicUrl = Split(PicUrl, "|")
        getDefaultPicUrl = arrPicUrl(0)
    End If
End Function
'获得图片列表样式一
Private Function getPicInfoList(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, strTable
    
   strSql = GetExecuteSql(PageType, ClassID, CommandType, IsNew, IsHot, ShowNum, SupplyType, True)

    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    Rows = 0
    If rsSupply.EOF And rsSupply.BOF Then
        getPicInfoList = "<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 & "><Img src=" & UploadDir & "/" & getDefaultPicUrl(rsSupply("SupplyPicUrl")) & " border='0 'width ='" & iWidth & "' height='" & iHeight & "' alt=" & rsSupply("SupplyTitle") & " /></a></td></tr><tr><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></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
    getPicInfoList = "<Table Width='100%'>" & strTable & "</Table>"
End Function


'获得信息列表
'2005-11-21
'刘永涛
Private Function getDetailInfoList(PageType, ClassID, CommandType, iCols, iLength, IsNew, IsHot, iWeight, iHeight, ShowNum, SupplyType, ShowInfoType)
    Dim strSql, strTable, strTemp, Rows, rsSupply
 
    strSql = GetExecuteSql(PageType, ClassID, CommandType, IsNew, IsHot, ShowNum, SupplyType, False)
    
    Set rsSupply = Server.CreateObject("ADODB.RecordSet")
    rsSupply.Open strSql, Conn, 1, 1
    If rsSupply.EOF And rsSupply.BOF Then
        getDetailInfoList = "<li>没有信息!<li>"
        rsSupply.Close
        Set rsSupply = Nothing
        Exit Function
    Else
        Do While Not rsSupply.EOF
            
            strTemp = strTemp & "<tr><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 & ">" & Left(rsSupply("SupplyTitle"), iLength) & "</a></td><td align='center'>" & GetSupplyInfoType(rsSupply("TradeType"), "//TradeType/Type") & "</td><td>" & rsSupply("Province") & "/" & rsSupply("City") & "</td><td>" & rsSupply("UpDateTime") & "</td></tr>" & vbCrLf
            rsSupply.MoveNext
        Loop
    End If
    rsSupply.Close
    Set rsSupply = Nothing
    getDetailInfoList = "<Table Width='100%'>" & strTemp & "</Table>"
End Function

'获得某一类别下的所有信息数
'2005-11-18
'刘永涛
Private Function getInfoCounts(ByVal ClassID, ByVal iType, ByVal SupplyType)
    'Call OpenConn()
    Dim strSql, QuerySql
    If SupplyType >= 0 Then
        QuerySql = " And SupplyType=" & SupplyType & " "
    End If
    Select Case iType
        Case 0
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And ClassId in (" & ClassID & ")"
        Case 1 '最新页的数量统计
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And DateDiff(" & PE_DatePart_D & "," & PE_Now & ",UpdateTime)<" & DaysOfNew & ""
        Case 2 '推荐页的数量统计
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And CommandType<>0"
        Case 3
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And Hits>=" & HitsOfHot & ""
        Case 4
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And SpecialId=" & SpecialID & ""
        Case 5
            strSql = "Select Count(*) From PE_Supply Where Status=1 And Deleted=" & PE_False & " And CommandType<>0 And SupplyPicUrl<>''"
    End Select
    getInfoCounts = PE_CLng(Conn.Execute(strSql & QuerySql)(0))
End Function

'=================================================
'函数名：ShowChannelCount
'作  用：显示频道统计信息
'参  数：无
'=================================================
Private Function GetChannelCount()
    Dim HitsCount_Channel, rs
    Set rs = Conn.Execute("select sum(Hits) from PE_Supply where ChannelID=" & ChannelID)
    If IsNull(rs(0)) Then
        HitsCount_Channel = 0
    Else
        HitsCount_Channel = rs(0)
    End If
    rs.Close
    Set rs = Nothing
    GetChannelCount = Replace(Replace(Replace(Replace(Replace(Replace(R_XmlText_Class("ChannelCount", "{$ChannelShortName}总数： {$ItemChecked_Channel} {$ChannelItemUnit}<br>待审{$ChannelShortName}： {$UnItemChecked} {$ChannelItemUnit}<br>评论总数： {$CommentCount_Channel} 条<br>专题总数： {$SpecialCount_Channel} 个<br>{$ChannelShortName}阅读： {$HitsCount_Channel} 人次<br>"), "{$ItemChecked_Channel}", ItemChecked_Channel), "{$ChannelItemUnit}", ChannelItemUnit), "{$UnItemChecked}", ItemCount_Channel - ItemChecked_Channel), "{$CommentCount_Channel}", CommentCount_Channel), "{$SpecialCount_Channel}", SpecialCount_Channel), "{$HitsCount_Channel}", HitsCount_Channel)
End Function


Private Function GetSupplyAction()
    GetSupplyAction = Replace(Replace(Replace(Replace(R_XmlText_Class("SupplyAction", "【<a href='{$ChannelUrl}/Comment.asp?SupplyID={$SupplyID}' target='_blank'>发表评论</a>】【<a href='{$InstallDir}User/User_Favorite.asp?Action=Add&ChannelID={$ChannelID}&InfoID={$SupplyID}' target='_blank'>加入收藏</a>】【<a href='javascript:window.close();'>关闭窗口</a>】"), "{$ChannelUrl}", ChannelUrl), "{$SupplyID}", SupplyID), "{$InstallDir}", strInstallDir), "{$ChannelID}", ChannelID)
End Function


Private Function GetSupplyUrl(ByVal SupplyID)
    GetSupplyUrl = strInstallDir & ChannelDir & "/ShowSupply.asp?SupplyID=" & SupplyID
End Function


Private Sub GetRegionValue()
    Response.Write "<script language='javascript'> " & vbCrLf
    Response.Write "getSelected('Region.asp',-1);" & vbCrLf
    Response.Write " var http_request = false; " & vbCrLf
    Response.Write " function InitRequest() {//初始化、指定处理函数、发送请求的函数 " & vbCrLf
    Response.Write "     http_request = false; " & vbCrLf
    Response.Write "     //开始初始化XMLHttpRequest对象 " & vbCrLf
    Response.Write "     if(window.XMLHttpRequest) { //Mozilla 浏览器 " & vbCrLf
    Response.Write "         http_request = new XMLHttpRequest(); " & vbCrLf
    Response.Write "         if (http_request.overrideMimeType) {//设置MiME类别 " & vbCrLf
    Response.Write "             http_request.overrideMimeType('text/xml'); " & vbCrLf
    Response.Write "         } " & vbCrLf
    Response.Write "     } " & vbCrLf
    Response.Write "     else if (window.ActiveXObject) { // IE浏览器 " & vbCrLf
    Response.Write "         try { " & vbCrLf
    Response.Write "             http_request = new ActiveXObject('Msxml2.XMLHTTP'); " & vbCrLf
    Response.Write "         } catch (e) { " & vbCrLf
    Response.Write "             try { " & vbCrLf
    Response.Write "                 http_request = new ActiveXObject('Microsoft.XMLHTTP'); " & vbCrLf
    Response.Write "             } catch (e) {} " & vbCrLf
    Response.Write "         } " & vbCrLf
    Response.Write "     } " & vbCrLf
    Response.Write "     if (!http_request) { // 异常，创建对象实例失败 " & vbCrLf
    Response.Write "         window.alert('不能创建XMLHttpRequest对象实例.'); " & vbCrLf
    Response.Write "         return false; " & vbCrLf
    Response.Write "     } " & vbCrLf
    Response.Write "      " & vbCrLf
    Response.Write " } " & vbCrLf
    Response.Write " //设定初始值 " & vbCrLf
    Response.Write " function getSelectValue(url,SelectName) " & vbCrLf
    Response.Write " { " & vbCrLf
    Response.Write "     InitRequest(); " & vbCrLf
    Response.Write "     http_request.onreadystatechange = function() " & vbCrLf
    Response.Write "     { " & vbCrLf
    Response.Write "         if (http_request.readyState == 4)  " & vbCrLf
    Response.Write "         { // 判断对象状态 " & vbCrLf
    Response.Write "             if (http_request.status == 200)  " & vbCrLf
    Response.Write "             { // 信息已经成功返回，开始处理信息 " & vbCrLf
    Response.Write "                //alert(unescape(http_request.responseText));" & vbCrLf
    Response.Write "                getClass(unescape(http_request.responseText),SelectName); " & vbCrLf
    Response.Write "             } else { //页面不正常 " & vbCrLf
    Response.Write "                 alert('您所请求的页面有异常。'); " & vbCrLf
    Response.Write "             } " & vbCrLf
    Response.Write "         } " & vbCrLf
    Response.Write "     }        " & vbCrLf
    Response.Write "     // 确定发送请求的方式和URL以及是否同步执行下段代码 " & vbCrLf
    Response.Write "     http_request.open('GET',url, false); " & vbCrLf
    Response.Write "     http_request.send(null); " & vbCrLf
    Response.Write " } " & vbCrLf
    Response.Write " function getClass(node,SelectName) " & vbCrLf
    Response.Write " { " & vbCrLf
    Response.Write "     SelectName.options.length =1 ;"
    Response.Write "     var arrstr = new Array(); " & vbCrLf
    Response.Write "     arrstr = node.split(','); " & vbCrLf
    Response.Write "     for(var i=0;i<arrstr.length-1;i++) " & vbCrLf
    Response.Write "     { " & vbCrLf
    Response.Write "         SelectName.options[i+1] =new Option(arrstr[i]); " & vbCrLf
    Response.Write "         SelectName.options[i+1].value = arrstr[i]; " & vbCrLf
    Response.Write "     } " & vbCrLf
    Response.Write " } " & vbCrLf
    Response.Write " function getSelected(url,selValue)" & vbCrLf
    Response.Write " {" & vbCrLf
    Response.Write "    if(selValue==-1)" & vbCrLf
    Response.Write "    {" & vbCrLf
    Response.Write "        getSelectValue(url,document.Searchform.mySelectProvince);" & vbCrLf
    Response.Write "    }else{" & vbCrLf
    Response.Write "        getSelectValue(url,selValue);" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write " }" & vbCrLf
    Response.Write "</script> " & vbCrLf
End Sub

Public Sub ShowFavorite()
    Response.Write "<table width='100%' cellpadding='2' cellspacing='1' border='0' class='border'>"
    Response.Write "  <tr class='title' align='center'><td width='30'>选中</td><td>" & ChannelShortName & "标题</td><td width='100'>发布人</td><td width='80'>更新时间</td><td width='80'>操作</td></tr>"
    
    Dim sqlFavorite, rsFavorite, iCount, strLink
    iCount = 0
    
    sqlFavorite = "select A.ChannelID,A.SupplyID,A.ClassID,C.ClassName,C.ParentDir,C.ClassDir,C.ClassPurview,A.SupplyTitle,A.UserName,A.UpdateTime,A.SupplyPicUrl from PE_Supply A left join PE_Class C on A.ClassID=C.ClassID where A.Deleted=" & PE_False & " and A.Status=1 "
    sqlFavorite = sqlFavorite & " and SupplyID in (select InfoID from PE_Favorite where ChannelID=" & ChannelID & " and UserID=" & UserID & ")"
    sqlFavorite = sqlFavorite & " order by A.SupplyID desc"
    MaxPerPage = 20
    Set rsFavorite = Server.CreateObject("ADODB.Recordset")
    rsFavorite.Open sqlFavorite, Conn, 1, 1
    If rsFavorite.BOF And rsFavorite.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td height='50' colspan='20' align='center'>没有收藏任何" & ChannelShortName & "</td></tr>"
    Else
        totalPut = rsFavorite.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsFavorite.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        
        Do While Not rsFavorite.EOF
            strLink = "[<a href='" & GetClassUrl(rsFavorite("ClassID")) & "'>" & rsFavorite("ClassName") & "</a>] "
            strLink = strLink & "<a href='" & GetSupplyUrl(rsFavorite("SupplyID")) & "' target='_blank'>" & rsFavorite("SupplyTitle") & "</a>"
            Response.Write "<tr class='tdbg'>"
            Response.Write "<td align='center' width='30'><input type='checkbox' name='InfoID' value='" & rsFavorite("SupplyID") & "'></td>"
            Response.Write "<td align='left'>" & strLink & "</td>"
            Response.Write "<td width='100' align='center'>" & rsFavorite("UserName") & "</td>"
            Response.Write "<td width='80' align='right'>" & Year(rsFavorite("UpdateTime")) & "-" & Right("0" & Month(rsFavorite("UpdateTime")), 2) & "-" & Right("0" & Day(rsFavorite("UpdateTime")), 2) & "</td>"
            Response.Write "<td width='80' align='center'><a href='User_Favorite.asp?Action=Remove&ChannelID=" & ChannelID & "&InfoID=" & rsFavorite("SupplyID") & "' onclick=""return confirm('确实不再收藏此" & ChannelShortName & "吗？');"">取消收藏</a></td>"
            Response.Write "</tr>"
            iCount = iCount + 1
            If iCount >= MaxPerPage Then Exit Do
            rsFavorite.MoveNext
        Loop
    End If
    rsFavorite.Close
    Set rsFavorite = Nothing
    Response.Write "</table>"
    Response.Write ShowPage("User_Favorite.asp?ChannelID=" & ChannelID & "", totalPut, 20, CurrentPage, True, True, ChannelItemUnit & ChannelShortName, False)
End Sub

Function XmlText_Class(ByVal iSmallNode, ByVal DefChar)
    XmlText_Class = XmlText("Supply", iSmallNode, DefChar)
End Function

Function R_XmlText_Class(ByVal iSmallNode, ByVal DefChar)
    R_XmlText_Class = Replace(XmlText("Supply", iSmallNode, DefChar), "{$ChannelShortName}", ChannelShortName)
End Function

End Class
%>