powereasy.common.manage.asp

个人网站比较简短

'        ChannelID ---- 频道ID
'返回值：显示频道中前4个关键字 +【更多】
'**************************************************
Public Function GetKeywordList(FilePrefix, ChannelID)
    Dim sqlGetKey, rsGetKey, strKeywordList
    strKeywordList = "<font color='blue'><="
    sqlGetKey = "select top 4 * from PE_NewKeys where ChannelID=" & ChannelID & " or ChannelID=0 order by LastUseTime Desc"
    Set rsGetKey = Conn.Execute(sqlGetKey)
    If rsGetKey.BOF And rsGetKey.EOF Then
        strKeywordList = strKeywordList & "【<font color='green'>无常用关键字</font>】"
    Else
        Do While Not rsGetKey.EOF
            strKeywordList = strKeywordList & "【<font color='green' onclick=""document.myform.Keyword.value+=(document.myform.Keyword.value==''?'':'|')+'" & FilterJS(Replace(rsGetKey("KeyText"), "'", "")) & "'"" style=""cursor:hand;"">" & FilterJS(rsGetKey("KeyText")) & "</font>】"
            rsGetKey.MoveNext
        Loop
    End If
    rsGetKey.Close
    Set rsGetKey = Nothing
    strKeywordList = strKeywordList & "【<font color='green' onclick=""window.open('" & FilePrefix & "_SourceList.asp?ChannelID=" & ChannelID & "&TypeSelect=KeyList', 'KeyList', 'width=600,height=450,resizable=0,scrollbars=yes');"" style=""cursor:hand;"">更多</font>】"
    strKeywordList = strKeywordList & "</font>"
    GetKeywordList = strKeywordList
End Function

'**************************************************
'方法名：SaveKeyword
'作  用：保存关键字
'**************************************************
Public Sub SaveKeyword(strKeyword)
    Dim rsKeyword, sqlKeyword, arrKeyword, i
    strKeyword = ReplaceBadChar(strKeyword) 
    If strKeyword = "" Then Exit Sub
    arrKeyword = Split(strKeyword, "|")
    Set rsKeyword = Server.CreateObject("adodb.recordset")
    For i = 0 To UBound(arrKeyword)
        sqlKeyword = "Select ChannelID,KeyText,Hits,LastUseTime from PE_NewKeys Where ChannelID=" & ChannelID & " and KeyText='" & arrKeyword(i) & "'"
        rsKeyword.Open sqlKeyword, Conn, 1, 3
        If rsKeyword.BOF And rsKeyword.EOF Then
            rsKeyword.addnew
            rsKeyword("ChannelID") = ChannelID
            rsKeyword("KeyText") = arrKeyword(i)
            rsKeyword("Hits") = 0
            rsKeyword("LastUseTime") = Now()
            rsKeyword.Update
        Else
            Do While Not rsKeyword.EOF
                rsKeyword("Hits") = rsKeyword("Hits") + 1
                rsKeyword("LastUseTime") = Now()
                rsKeyword.Update
                rsKeyword.MoveNext
            Loop
        End If
        rsKeyword.Close
    Next
    Set rsKeyword = Nothing
End Sub

'**************************************************
'函数名：ReplaceText
'作  用：过滤非法字符串
'参  数：iText-----输入字符串
'返回值：替换后字符串
'**************************************************
Function ReplaceText(iText, iType)
    Dim rText, rsKey, sqlKey, i, Keyrow, Keycol
    If PE_Cache.GetValue("Site_ReplaceText") = "" Then
        Set rsKey = Server.CreateObject("Adodb.RecordSet")
        sqlKey = "Select Source,ReplaceText,OpenType,ReplaceType,Priority from PE_KeyLink where isUse=1 and LinkType=1 order by Priority"
        rsKey.Open sqlKey, Conn, 1, 1
        If Not (rsKey.BOF And rsKey.EOF) Then
            PE_Cache.SetValue "Site_ReplaceText", rsKey.GetString(, , "|||", "@@@", "")
            rsKey.Close
            Set rsKey = Nothing
        Else
            rsKey.Close
            Set rsKey = Nothing
            ReplaceText = iText
            Exit Function
        End If
    End If
    rText = iText
    Keyrow = Split(PE_Cache.GetValue("Site_ReplaceText"), "@@@")
    For i = 0 To UBound(Keyrow) - 1
        Keycol = Split(Keyrow(i), "|||")
        If Int(Keycol(3)) = 0 Or Int(Keycol(3)) = iType Then rText = PE_Replace(rText, Keycol(0), Keycol(1))
    Next
    ReplaceText = rText
End Function

'**************************************************
'函数名：ShowClassPath
'作  用：显示栏目路径
'参  数：无
'返回值：显示栏目
'**************************************************
Public Function ShowClassPath()
    If ParentPath = "" Or IsNull(ParentPath) Then
        ShowClassPath = "不属于任何栏目"
        Exit Function
    End If
    Dim strPath
    If Depth > 0 Then
        Dim rsPath
        Set rsPath = Conn.Execute("select * from PE_Class where ClassID in (" & ParentPath & ") order by Depth")
        Do While Not rsPath.EOF
            strPath = strPath & rsPath("ClassName") & " >> "
            rsPath.MoveNext
        Loop
        rsPath.Close
        Set rsPath = Nothing
    End If
    strPath = strPath & ClassName
    ShowClassPath = strPath
End Function



'**************************************************
'函数名：GetUserGroup
'作  用：显示用户组导航
'参  数：arrGroupID ---- 指定默认用户组
'返回值：用户组表格导航
'**************************************************
Function GetUserGroup(arrGroupID, strDisabled)
    If IsNull(arrGroupID) Then Exit Function
    Dim rsGroup, strGroup, i
    strGroup = "<table width='95%' align='right'><tr>"
    Set rsGroup = Conn.Execute("select GroupID,GroupName from PE_UserGroup order by GroupType asc,GroupID asc")
    Do While Not rsGroup.EOF
        strGroup = strGroup & "<td><input type='checkbox' name='GroupID' value='" & rsGroup(0) & "'" & strDisabled
        If FoundInArr(arrGroupID, rsGroup(0), ",") = True Then
            strGroup = strGroup & " checked"
        End If
        strGroup = strGroup & ">" & rsGroup(1) & "</td>"
        i = i + 1
        rsGroup.MoveNext
        If i Mod 5 = 0 And Not rsGroup.EOF Then
            strGroup = strGroup & "</tr><tr>"
        End If
    Loop
    rsGroup.Close
    Set rsGroup = Nothing
    strGroup = strGroup & "</table>"
    GetUserGroup = strGroup
End Function

Sub UpdateChannelData(ByVal iChannelID)
    Dim rsChannel, sqlChannel, trs, ModuleName
    Dim ItemCount, ItemChecked, CommentCount, SpecialCount
    sqlChannel = "select ChannelID,ModuleType,ItemCount,ItemChecked,CommentCount,SpecialCount from PE_Channel"
    Set rsChannel = Server.CreateObject("Adodb.RecordSet")
    If IsValidID(iChannelID) = False Then
        iChannelID = ""
    End If
    
    If InStr(iChannelID, ",") > 0 Then
        sqlChannel = sqlChannel & " where ChannelID in (" & iChannelID & ")"
    ElseIf PE_CLng(iChannelID) > 0 Then
        sqlChannel = sqlChannel & " where ChannelID=" & iChannelID & ""
    Else
        sqlChannel = sqlChannel & " where ChannelType<=1 order by ChannelID"
    End If
    rsChannel.Open sqlChannel, Conn, 1, 3
    Do While Not rsChannel.EOF
        Select Case rsChannel("ModuleType")
        Case 7
            Dim i, HouseTableName
            For i = 1 To 5
                Select Case i
                Case 1
                    HouseTableName = "PE_HouseCS"
                Case 2
                    HouseTableName = "PE_HouseCZ"
                Case 3
                    HouseTableName = "PE_HouseQG"
                Case 4
                    HouseTableName = "PE_HouseQZ"
                Case 5
                    HouseTableName = "PE_HouseHZ"
                End Select
                Set trs = Conn.Execute("select Count(HouseID) from " & HouseTableName & " where Deleted=" & PE_False & "")
                ItemCount = ItemCount + trs(0)
                Set trs = Nothing
                Set trs = Conn.Execute("select Count(HouseID) from " & HouseTableName & " where Passed=" & PE_True & " and Deleted=" & PE_False & "")
                ItemChecked = ItemChecked + trs(0)
                Set trs = Nothing
            Next
            rsChannel("ItemCount") = ItemCount
            rsChannel("ItemChecked") = ItemChecked
        Case 8
            Set trs = Conn.Execute("select Count(PositionID) from PE_Position ")
            ItemCount = ItemCount + trs(0)
            Set trs = Nothing
            rsChannel("ItemCount") = ItemCount
        Case Else
            Select Case rsChannel("ModuleType")
            Case 1
                ModuleName = "Article"
            Case 2
                ModuleName = "Soft"
            Case 3
                ModuleName = "Photo"
            Case 5
                ModuleName = "Product"
            Case 6
                ModuleName = "Supply"
            End Select
            Set trs = Conn.Execute("select Count(" & ModuleName & "ID) from PE_" & ModuleName & " where ChannelID=" & rsChannel("ChannelID") & " and Deleted=" & PE_False & "")
            ItemCount = trs(0)
            Set trs = Nothing

            If ModuleName = "Product" Then
                Set trs = Conn.Execute("select Count(" & ModuleName & "ID) from PE_" & ModuleName & " where ChannelID=" & rsChannel("ChannelID") & " and EnableSale=" & PE_True & " and Deleted=" & PE_False & "")
            Else
                Set trs = Conn.Execute("select Count(" & ModuleName & "ID) from PE_" & ModuleName & " where ChannelID=" & rsChannel("ChannelID") & " and Status=3 and Deleted=" & PE_False & "")
            End If
            ItemChecked = trs(0)
            Set trs = Nothing

            Set trs = Conn.Execute("select Count(CommentID) from PE_Comment C inner join PE_" & ModuleName & " I on C.InfoID=I." & ModuleName & "ID where I.ChannelID=" & rsChannel("ChannelID") & "")
            CommentCount = trs(0)
            Set trs = Nothing

            Set trs = Conn.Execute("select Count(SpecialID) from PE_Special where ChannelID=" & rsChannel("ChannelID") & "")
            SpecialCount = trs(0)
            Set trs = Nothing

            rsChannel("ItemCount") = ItemCount
            rsChannel("ItemChecked") = ItemChecked
            rsChannel("CommentCount") = CommentCount
            rsChannel("SpecialCount") = SpecialCount
        End Select
        rsChannel.Update
        rsChannel.MoveNext
    Loop
    rsChannel.Close
    Set rsChannel = Nothing
End Sub

Sub UpdateUserData(UserType, UserName, BeginID, EndID)
    Dim sqlUser, rsUser, trs, PostItems, PassedItems
    If UserType = 0 Then
        If InStr(UserName, ",") > 0 Then
            sqlUser = "select * from PE_User where UserName in ('" & Replace(UserName, ",", "','") & "')"
        Else
            sqlUser = "select * from PE_User where UserName='" & UserName & "'"
        End If
    Else
        sqlUser = "select * from PE_User where UserID>=" & BeginID & " and UserID<=" & EndID
    End If
    Set rsUser = Server.CreateObject("Adodb.RecordSet")
    rsUser.Open sqlUser, Conn, 1, 3
    Do While Not rsUser.EOF
        Set trs = Conn.Execute("select count(ArticleID) from PE_Article where Deleted=" & PE_False & " and  Inputer='" & rsUser("UserName") & "'")
        If IsNull(trs(0)) Then
            PostItems = 0
        Else
            PostItems = trs(0)
        End If
        Set trs = Nothing
        Set trs = Conn.Execute("select count(ArticleID) from PE_Article where Deleted=" & PE_False & " and Status=3 and Inputer='" & rsUser("UserName") & "'")
        If IsNull(trs(0)) Then
            PassedItems = 0
        Else
            PassedItems = trs(0)
        End If
        Set trs = Nothing
        Set trs = Conn.Execute("select count(SoftID) from PE_Soft where Deleted=" & PE_False & " and  Inputer='" & rsUser("UserName") & "'")
        If Not IsNull(trs(0)) Then PostItems = PostItems + trs(0)
        Set trs = Nothing
        Set trs = Conn.Execute("select count(SoftID) from PE_Soft where Deleted=" & PE_False & " and  Status=3 and Inputer='" & rsUser("UserName") & "'")
        If Not IsNull(trs(0)) Then PassedItems = PassedItems + trs(0)
        Set trs = Nothing
        Set trs = Conn.Execute("select count(PhotoID) from PE_Photo where Deleted=" & PE_False & " and  Inputer='" & rsUser("UserName") & "'")
        If Not IsNull(trs(0)) Then PostItems = PostItems + trs(0)
        Set trs = Nothing
        Set trs = Conn.Execute("select count(PhotoID) from PE_Photo where Deleted=" & PE_False & " and  Status=3 and Inputer='" & rsUser("UserName") & "'")
        If Not IsNull(trs(0)) Then PassedItems = PassedItems + trs(0)
        Set trs = Nothing
        
        rsUser("PostItems") = PostItems
        rsUser("PassedItems") = PassedItems
        rsUser.Update
        rsUser.MoveNext
    Loop
    rsUser.Close
    Set rsUser = Nothing
End Sub

%>