admin_collection.asp

个人网站比较简短

    ListNum = PE_CLng(Trim(Request("ListNum")))                     'ListNum    列表数
    Arr_i = PE_CLng(Trim(Request("Arr_i")))                         'Arr_i      当前列表的第几文章数
    CollecNewsi = PE_CLng(Trim(Request("CollecNewsi")))             'CollecNewsi    显示采集成功数
    CollecNewsj = PE_CLng(Trim(Request("CollecNewsj")))             'CollecNewsj    显示采集失败数
    ListPaingNext = Trim(Request("ListPaingNext"))                  'ListPaingNext  显示采集列表下一页
    ItemIDStr = Replace(ReplaceBadChar(Trim(Request("ItemID"))), " ", "") 'ItemIDStr 项目数组
    CollecNewsA = PE_CLng(Trim(Request("CollecNewsA")))             'CollecNewsA 采集文章数
    ItemIDtemp = PE_CLng(Trim(Request("ItemIDtemp")))               'ItemIDtemp  项目是否首次加载
    rnd_temp = CStr(Trim(Request("rnd_temp")))                      'rnd_temp    用于随机数不同的缓存
    ArticleList = CStr(Trim(Request("ArticleList")))                'ArticleList 用于缓存不同的列表
    ItemSucceedNum = PE_CLng(Trim(Request("ItemSucceedNum")))       'ItemSucceedNum 项目采集成功数为记录不同项目采集成功数用于多项目指定的采集数量
    ItemSucceedNum2 = PE_CLng(Trim(Request("ItemSucceedNum2")))     'ItemSucceedNum2 成功采集项目数
    ImagesNumAll = PE_CLng(Trim(Request("ImagesNumAll")))           'ImagesNumAll    项目总数
    CollecType = PE_CLng(Trim(Request("CollecType")))               'CollecType    采集模式 0 稳定 1 快速 2 链接 3 断点续采
    CollectionCreateHTML = Trim(Request("CollectionCreateHTML"))    'CollectionCreateHTML    生成html数组
    TimingCreate = Trim(Request("TimingCreate"))                    'TimingCreate  定时生成html
    Timing_AreaCollection = Trim(Request("Timing_AreaCollection"))  'Timing_AreaCollection  定时区域采集

    If CollecType = 3 Then
        '断点续采
        sql = "select top 1 Timing_Breakpoint from PE_config"
        Set rs = Server.CreateObject("adodb.recordset")
        rs.Open sql, Conn, 1, 3
        Response.Write rs("Timing_Breakpoint")
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If

    If Trim(Request("CollecTest")) = "yes" Then
        CollecTest = True
    Else
        CollecTest = False
    End If
    If Trim(Request("Content_view")) = "yes" Then
        Content_view = True
    Else
        Content_view = False
    End If

    If Trim(Request("IsTitle")) = "yes" Then
        IsTitle = True
    Else
        IsTitle = False
    End If

    If Trim(Request("IsLink")) = "yes" Then
        IsLink = True
    Else
        IsLink = False
    End If
	If IsValidID(ItemIDStr) = False Then
		ItemIDStr = ""
	End If

    If ItemIDStr = "" Then
        FoundErr = True
        ErrMsg = "<li>参数错误,请选择项目！</li>"
        Call WriteErrMsg(ErrMsg, ComeUrl)
        Exit Sub
    ElseIf ItemIDStr = "0" Then '为定时管理跳转
        Response.Write " <meta http-equiv=""refresh"" content=0;url=""Admin_Timing.asp?Action=DoTiming&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
        Exit Sub
    End If
     
    '是否全部采集完成
    'ItemNum 当前项目数 ItemIDStr 项目数组 分割数组 ItemIDArray 得到项目数 ItemIDArray 得到每一个项目数
    ItemIDArray = Split(ItemIDStr, ",")
    If (ItemNum - 1) > UBound(ItemIDArray) Then
        ItemEnd = True
        ErrMsg = "<br>全部项目采集任务完成！"
        ErrMsg = ErrMsg & "<li>成功采集： <font color=red>" & CollecNewsi & "</font>  篇,失败：<font color=blue> " & CollecNewsj & "</font>  篇,图片：<font color=green>" & ImagesNumAll & "</font> 个。</li>"

        '清空断点记录
        sql = "select Timing_Breakpoint from PE_config"
        Set rs = Server.CreateObject("adodb.recordset")
        rs.Open sql, Conn, 1, 3
        rs("Timing_Breakpoint") = ""
        rs.Update
        rs.Close
        Set rs = Nothing
        
        '清除缓存
        Call PE_Cache.DelAllCache
        Call WriteSuccessMsg2(ErrMsg)
        Exit Sub
    End If
    
    '加载初始项目入缓存
    If ItemIDtemp = 0 Then
        Call SetCache
        ItemIDtemp = 1
    Else
        If PE_Cache.CacheIsEmpty("Collection" & rnd_temp) Then
            Call SetCache
            ArticleList = ""
        End If
    End If
    
    '加载缓存
    Arr_Item = PE_Cache.GetValue("Collection" & rnd_temp)
    Arr_Filters = PE_Cache.GetValue("Arr_Filters" & rnd_temp)
    Arr_Histrolys = PE_Cache.GetValue("Arr_Histrolys" & rnd_temp)
    Call loadItem
    
    If CollectionNum <> "" Then   '是否到了指定的成功采集数
        If CollectionType = 0 Then  '是否到了指定的成功采集数
            If ItemSucceedNum = PE_CLng(CollectionNum) Then
                ErrMsg = "<li>已经成功采集了" & ItemName & "项目<font color=red>" & CollectionNum & "</font>篇指定采集数。</li>"
                ErrMsg = ErrMsg & "<br><font color=red>" & ItemName & "</font> 项目采集任务完成！</li>"
                Call WriteSuccessMsg2(ErrMsg)
                Exit Sub
            End If
        End If
        If CollectionType = 1 Then  '是否到了每页的要的采集数
            If ListNum > PE_CLng(CollectionNum) Then
                ErrMsg = "<li>已经成功采集了" & ItemName & "项目<font color=red>" & CollectionNum & "</font>篇指定列数。</li>"
                ErrMsg = ErrMsg & "<br><font color=red>" & ItemName & "</font> 项目采集任务完成！</li>"
                Call WriteSuccessMsg2(ErrMsg)
                Exit Sub
            End If
        End If
    End If
    
    '更新项目记录时间
    If ListNum = 1 And CollecTest = False Then
        sql = "select top 1 * from PE_Item where ItemID=" & ItemID
        Set rs = Server.CreateObject("adodb.recordset")
        rs.Open sql, Conn, 1, 3
        rs("NewsCollecDate") = Now()
        rs.Update
        rs.Close
        Set rs = Nothing
    End If
    
    If LoginType = 1 And ListNum = 1 Then '采集登录
        '登录网站
        LoginData = UrlEncoding(LoginUser & "&" & LoginPass)
        LoginResult = PostHttpPage(LoginUrl, LoginPostUrl, LoginData, PE_CLng(WebUrl))
        If InStr(LoginResult, LoginFalse) > 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>在登录网站时发生错误,请确保登录信息的正确性！</li>"
            ItemNum = ItemNum + 1
            ListNum = 1
            ArticleList = ""
            Response.Write "   <meta http-equiv=""refresh"" content=" & TimeNum & ";url=""Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&CollecNewsj=" & CollecNewsj & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
            Call WriteErrMsg(ErrMsg, ComeUrl)
            Exit Sub
        End If
    End If
    
    If FoundErr <> True And ItemEnd <> True Then
        '继续采集列表
        If ArticleList = "" Then  '加载列表处理
            '判断列表类型
            '不作分页设置
            If ListPaingType = 0 Then
                If ListNum = 1 Then
                    '列表链接=列表索引页面
                    ListUrl = ListStr
                Else
                    ListEnd = True
                End If
            '设置标签
            ElseIf ListPaingType = 1 Then
                '判断列表为1时加载链接地址
                If ListNum = 1 Then
                    ListUrl = ListStr
                Else
                    If ListPaingNext = "" Or ListPaingNext = "$False$" Then
                        ListEnd = True
                    Else
                        If InStr(ListPaingNext, "{$ID}") > 0 Then
                            ListPaingNext = Replace(ListPaingNext, "{$ID}", "&")
                        End If
                        ListUrl = ListPaingNext
                    End If
                End If
            '批量生成
            ElseIf ListPaingType = 2 Then
                If ListPaingID1 > ListPaingID2 Then
                    If (ListPaingID1 - ListNum + 1) < ListPaingID2 Or (ListPaingID1 - ListNum + 1) < 0 Then
                        ListEnd = True
                    Else
                        ListUrl = Replace(ListPaingStr2, "{$ID}", CStr(ListPaingID1 - ListNum + 1))
                    End If
                Else
                    If (ListPaingID1 + ListNum - 1) > ListPaingID2 Then
                        ListEnd = True
                    Else
                        ListUrl = Replace(ListPaingStr2, "{$ID}", CStr(ListPaingID1 + ListNum - 1))
                    End If
                End If
            '手动添加
            ElseIf ListPaingType = 3 Then
                ListArray = Split(ListPaingStr3, vbCrLf)
                If (ListNum - 1) > UBound(ListArray) Then
                    ListEnd = True
                Else
                    ListUrl = ListArray(ListNum - 1)
                End If
            End If
            If ListEnd <> True Then
                If CheckUrl(ListStr) = False Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>列表网址不对！</li>"
                End If
                ArticleList = ListUrl
                If InStr(ListUrl, "{$ID}") > 0 Then
                    ListUrl = Replace(ListUrl, "{$ID}", "&")
                End If
                If FoundErr <> True Then
                    ListCode = GetHttpPage(ListUrl, PE_CLng(WebUrl)) '获取网页源代码 ListCode
                    '类型为设置标签时
                    If ListPaingType = 1 Then
                        ListPaingNext = GetPaing(ListCode, LPsString, LPoString, False, False)
                        If ListPaingNext <> "$False$" Then
                            If ListPaingStr1 <> "" Then
                                ListPaingNext = Replace(ListPaingStr1, "{$ID}", ListPaingNext)
                            Else
                                ListPaingNext = DefiniteUrl(ListPaingNext, ListUrl)
                            End If
                            If InStr(ListPaingNext, "&") > 0 Then