admin_collection.asp

个人网站比较简短

    Response.Write "    <td width=""40"" align=""center""><strong>可运行</strong></td>        " & vbCrLf
    Response.Write "    <td width=""120"" height=""22"" align=""center""><strong>上次采集时间</strong></td>" & vbCrLf
    Response.Write "    <td width=""60"" height=""22"" align=""center""><strong>成功记录</strong></td>" & vbCrLf
    Response.Write "    <td width=""60"" height=""22"" align=""center""><strong>失败记录</strong></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf

    sql = "SELECT I.*,C.ChannelName,CL.ClassName,C.Disabled,C.ModuleType "
    sql = sql & " FROM (PE_Item I left JOIN PE_Channel C ON I.ChannelID =C.ChannelID)"
    sql = sql & " Left JOIN PE_Class CL ON I.ClassID = CL.ClassID"
    sql = sql & " where C.ModuleType=1 and I.Flag=" & PE_True
    If iChannelID <> 0 Then sql = sql & " And I.ChannelID=" & iChannelID
    sql = sql & " ORDER BY I.Flag "
        If SystemDatabaseType = "SQL" Then
        sql = sql & "desc"
    Else
        sql = sql & "asc"
    End If
    sql = sql & ", I.ItemID DESC, I.NewsCollecDate DESC"

    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn, 1, 1
    If rs.BOF And rs.EOF Then
        Response.Write "<tr class='tdbg' height='50'><td colspan='9' align='center'>系统中暂无采集项目！</td></tr></table>"
    Else
        totalPut = rs.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
                rs.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        Dim VisitorNum
        VisitorNum = 0
        Do While Not rs.EOF
            ChannelID = rs("ChannelID")
            ClassID = PE_CLng(rs("ClassID"))
            ItemID = rs("ItemID")
            ItemName = rs("ItemName")
            ListUrl = rs("ListStr")
            WebName = rs("WebName")
            NewsCollecDate = rs("NewsCollecDate")
            Flag = rs("Flag")
            
            Response.Write "<tr class=""tdbg"" onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">" & vbCrLf
            Response.Write "  <td width=""40"" align=""center"" height='25'>" & vbCrLf

            Response.Write "    <input type=""checkbox"" value=" & ItemID & " name=""ItemID"""
            If rs("Disabled") = True Or Flag <> True Or IsNull(rs("ChannelName")) = True Then
                Response.Write " disabled"
            End If
            Response.Write "> " & vbCrLf
            Response.Write "  </td>" & vbCrLf
            Response.Write "  <td width=""100"" align=""center"">" & ItemName & "</td> " & vbCrLf
            Response.Write "  <td width=""100"" align=""center""><a href=" & ListUrl & " target=""_bank"">" & WebName & "</a></td>  " & vbCrLf
            Response.Write "  <td width=""100"" height=""22"" align=""center"">"
            If IsNull(rs("ChannelName")) = True Then
                Response.Write "还没有指定频道"
            Else
                If rs("Disabled") = True Then
                    Response.Write rs("ChannelName") & "<font color=red>&nbsp;已禁用</font>"
                Else
                    Response.Write rs("ChannelName")
                End If
            End If
            Response.Write "</td> " & vbCrLf
            Response.Write "  <td width=""100"" align=""center"">"
            If IsNull(rs("ClassName")) = True Then
                Response.Write "还没有指定栏目"
            Else
                Response.Write rs("ClassName")
            End If
            Response.Write "</td>" & vbCrLf
            Response.Write "  <td width=""40"" align=""center"">" & vbCrLf
            If Flag = True Then
                Response.Write "<b>√</b>"
            Else
                Response.Write "<FONT color='red'><b>×</b></FONT>"
            End If
            Response.Write "  </td>" & vbCrLf
            Response.Write "  <td width=""120"" align=""center"">" & vbCrLf
            If DateDiff("d", NewsCollecDate, Now()) = 0 Then
                Response.Write "<font color=red>" & NewsCollecDate & "</font>"
            Else
                Response.Write NewsCollecDate
            End If
            Response.Write "  </td>" & vbCrLf
            Response.Write "  <td width=""60"" align=""center"">" & vbCrLf
            Response.Write "   <a href='Admin_CollectionHistory.asp?Action=main&SelectCollateItemID=" & ItemID & "&HistrolyResult=true'>&nbsp;"
            Call HistrolyNum(ItemID, PE_True)
            Response.Write "</a>" & vbCrLf
            Response.Write "  </td>" & vbCrLf
            Response.Write "  <td width=""60"" align=""center"">" & vbCrLf
            Response.Write "   <a href='Admin_CollectionHistory.asp?Action=main&SelectCollateItemID=" & ItemID & "&HistrolyResult=false'>&nbsp;"
            Call HistrolyNum(ItemID, PE_False)
            Response.Write "</a>" & vbCrLf
            Response.Write "  </td>" & vbCrLf
            Response.Write "</tr> " & vbCrLf

            VisitorNum = VisitorNum + 1
            If VisitorNum >= MaxPerPage Then Exit Do
            rs.MoveNext
        Loop
        Response.Write "<tr class='tdbg'>" & vbCrLf
        Response.Write "  <td colspan='7' align=""right"">合计：</td>" & vbCrLf
        Response.Write "  <td align='center' width='60'>" & vbCrLf
        SqlH = "select count(HistrolyNewsID) from PE_HistrolyNews where  Result=" & PE_True
        Set RsH = Conn.Execute(SqlH)
        If RsH.BOF And RsH.EOF Then
            Response.Write "&nbsp;<font color='green'>0</font>"
        Else
            Response.Write "&nbsp;<font color='blue'>" & RsH(0) & "</font>"
        End If
        RsH.Close
        Set RsH = Nothing
        Response.Write "  </td>" & vbCrLf
        Response.Write "  <td align='center' width='60'>" & vbCrLf
        SqlH = "select count(HistrolyNewsID) from PE_HistrolyNews where  Result=" & PE_False
        Set RsH = Conn.Execute(SqlH)
        If RsH.BOF And RsH.EOF Then
            Response.Write "&nbsp;<font color='green'>0</font>"
        Else
            Response.Write "&nbsp;<font color='red'>" & RsH(0) & "</font>"
        End If
        RsH.Close
        Set RsH = Nothing
        Response.Write "  </td>" & vbCrLf
        Response.Write "</tr>" & vbCrLf
        Response.Write "<tr class='tdbg'>" & vbCrLf
        Response.Write "  <td colspan='2'>" & vbCrLf
        Response.Write "     <input name=""chkAll"" type=""checkbox"" id=""chkAll"" onclick=CheckAll(this.form) value=""checkbox"" > &nbsp;全选 &nbsp;&nbsp;"
        Response.Write "  </td>" & vbCrLf
        Response.Write "  <td colspan='7'>" & vbCrLf
        Response.Write "    <input name=""ItemNum"" type=""hidden"" id=""ItemNum"" value=""1"">"
        Response.Write "    <input name=""ListNum"" type=""hidden"" id=""ListNum"" value=""1"">"
        Response.Write "    <input name=""Arr_i"" type=""hidden"" id=""Arr_i"" value=""0"">"
        Response.Write "    <input name=""CollecNewsA"" type=""hidden"" id=""CollecNewsA"" value=""0"">"
        Response.Write "    <input name=""CollecNewsi"" type=""hidden"" id=""CollecNewsi"" value=""0"">"
        Response.Write "    <input name=""ItemSucceedNum"" type=""hidden"" id=""ItemSucceedNum"" value=""0"">"
        Response.Write "    <input name=""ItemSucceedNum2"" type=""hidden"" id=""ItemSucceedNum2"" value=""0"">"
        Response.Write "    <input name=""CollecNewsj"" type=""hidden"" id=""CollecNewsj"" value=""0"">"
        Response.Write "    <input name=""ImagesNumAll"" type=""hidden"" id=""ImagesNumAll"" value=""0"">"
        Response.Write "    <input name=""ItemIDtemp"" type=""hidden"" id=""ItemIDtemp"" value=""0"">"
        Response.Write "    <input name=""Action"" type=""hidden"" id=""Action"" value=""Start"">"
        Response.Write "    <input name=""CollecType"" type=""hidden"" id=""ItemNum"" value=""1"">"
        Response.Write "    <INPUT TYPE='checkbox' NAME='CollecTest' value='yes' zzz='1' onclick=""javascript:document.myform.Content_View.checked=true""> 不录入数据库，只测试采集功能是否正常<br>" & vbCrLf
        Response.Write "    <INPUT TYPE='checkbox' NAME='Content_View' value='yes' zzz='1'> 采集过程中预览文章内容<br>" & vbCrLf
        Response.Write "    <INPUT TYPE='checkbox' NAME='IsTitle' value='yes' zzz='1'> 不采集保存栏目中已有的相同标题文章<br>" & vbCrLf
        Response.Write "    <INPUT TYPE='checkbox' NAME='IsLink' value='yes' zzz='1'> 内部链接采集（此选项只针对链接采集）<br>" & vbCrLf
        Response.Write "  </td>" & vbCrLf
        Response.Write "</tr>" & vbCrLf
        Response.Write "<tr class='tdbg'>" & vbCrLf
        Response.Write "  <td colspan='9' height='32' align='center'>" & vbCrLf
        Response.Write "    <input type=""submit"" value=""快 速 采 集"" name=""submit"" onclick=""javascript:mysub();document.myform.Action.value='Start';document.myform.CollecType.value=1"" >&nbsp;&nbsp;&nbsp;"
        Response.Write "    <input type=""submit"" value=""稳 定 采 集"" name=""submit"" onclick=""javascript:mysub();document.myform.Action.value='Start';document.myform.CollecType.value=0"" >&nbsp;&nbsp;&nbsp;"
        Response.Write "    <input type=""submit"" value=""链 接 采 集"" name=""submit"" onclick=""javascript:if (confirm('链接采集，就是只采集对方网站的链接，不采集正文，这里建议您设置好采集项目的标题和简介，在按扭的上方可设置是内部链接还是外部链接，内部链接就是文章内容只保存对方的URL您可以在模板加内联页加以扩展，外部链接就是列表点击后转向链接，您确定使用链接采集么？')){mysub();document.myform.Action.value='Start';document.myform.CollecType.value=2;}else{return false;};"" >&nbsp;&nbsp;&nbsp;"
        Response.Write "    <input type=""submit"" value=""断 点 续 采 "" name=""submit"""
        '得到断点记录
        Dim rsBreakpoint
        sql = "select top 1 Timing_Breakpoint from PE_config"
        Set rsBreakpoint = Server.CreateObject("adodb.recordset")
        rsBreakpoint.Open sql, Conn, 1, 3
        If rsBreakpoint("Timing_Breakpoint") = "" Then
            Response.Write " disabled"
        End If
        Response.Write "    onclick=""javascript:if (confirm('上次采集因为您停止了采集项目或XMLHTTP组件服务器故障导致中止，现在您是否继续上次的采集项目？')){mysub();document.myform.Action.value='Start';document.myform.CollecType.value=3;}else{return false;};"" >&nbsp;&nbsp;&nbsp;"
        rsBreakpoint.Close
        Set rsBreakpoint = Nothing
        Response.Write "    <input type=""submit"" value=""检测采集项目"" name=""CheckItem"" onclick=""javascript:if (confirm('当你的采集项目比较多，而且长时间未使用采集时，你可能不能确定哪些采集项目还能正常使用，在此情况下你可以使用本功能来检测。此功能非常耗时，请尽量少用。确定要进行检测吗？')){mysub();document.myform.Action.value='CheckItem'}else{return false;};"" ></td>"
        Response.Write "  </td></tr>" & vbCrLf
        Response.Write "</form>" & vbCrLf
        Response.Write "</table>" & vbCrLf

        If totalPut > 0 Then
            Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个项目记录", True)
        End If
        Response.Write "<br>" & vbCrLf
        Response.Write "<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""1"" class=""border"" >" & vbCrLf
        Response.Write "  <tr>" & vbCrLf
        Response.Write "   <td colspan='2' height=""20"" align=""center""><font color=#ff6600><strong>声明：因使用本系统提供的采集功能所引起或导致的一切法律或经济责任都由使用者承担，本系统开发商不承担任何责任！</strong></font></td>" & vbCrLf
        Response.Write "  </tr>" & vbCrLf
        Response.Write "</table>" & vbCrLf
    End If
    rs.Close
    Set rs = Nothing
    Response.Write " <div id=""esave"" style=""position:absolute; top:50px; left:200px; z-index:1;visibility:hidden""> " & vbCrLf
    Response.Write "    <TABLE WIDTH=400 BORDER=0 CELLSPACING=0 CELLPADDING=0>" & vbCrLf
    Response.Write "      <TR><td width=""20%""></td>" & vbCrLf
    Response.Write "    <TD width=""60%""> " & vbCrLf
    Response.Write "    <TABLE WIDTH=100% height=100 BORDER=0 CELLSPACING=1 CELLPADDING=0>" & vbCrLf
    Response.Write "    <TR> " & vbCrLf
    Response.Write "      <td bgcolor=""#0033FF"" align=center><b><marquee align=""middle"" behavior=""alternate"" scrollamount=""5""><font color=#FFFFFF>正在加载采集项目,请稍候...</font></marquee></b></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    </table>" & vbCrLf
    Response.Write "    </td><td width='20%'></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    </table>" & vbCrLf
    Response.Write "  </div>" & vbCrLf
    Response.Write " <table WIDTH=400 height=130 BORDER=0 CELLSPACING=0 CELLPADDING=0><tr><td></td></tr></table>" & vbCrLf
    Call CloseConn
End Sub

'=================================================
'过程名：Start
'作  用：保存批量采集文章
'=================================================
Sub Start()
    FoundErr = False                    '是否有错务
    ItemEnd = False                     '是否采集项目完成
    ListEnd = False                     '是否采集列表完成
    ErrMsg = ""                         '错务说明
    TimeNum = 3     '等待时间
    ItemNum = PE_CLng(Trim(Request("ItemNum")))                     'ItemNum    项目数