<!--#include file="Item_Conn.asp"-->
<!--#include file="Item_Function.asp"-->
<html>
<head>
<title>新闻采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="../../Skins/Admin_Style.Css" rel="stylesheet" type="text/css">
<script Language="JavaScript" src="../../Inc/Js/admin.js"></script>
</head>
<body leftmargin="2" topmargin="0" marginwidth="0" marginheight="0">
<%
Dim ItemNum,ListNum,ListSuccesNum,ListFalseNum,NewsNumAll
Dim RsItem,SqlItem,ItemEnd,ListEnd

'项目变量
Dim ItemID,ItemName,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr,CollecListNum,CollecNewsNum

'采集相关的变量
Dim Arr_i,NewsUrl

'其它变量
Dim LoginData,LoginResult
Dim Arr_Item,CacheTemp,CollecOrder,OrderTemp

'执行时间变量
Dim StartTime,OverTime

'列表
Dim ListUrl,ListCode,NewsArrayCode,NewsArray,ListArray,ListPaingNext,ListPaingTemp

CacheTemp=Lcase(Trim(request.ServerVariables("SCRIPT_NAME")))
CacheTemp=left(CacheTemp,instrrev(CacheTemp,"/"))
CacheTemp=replace(CacheTemp,"\","_")
CacheTemp=replace(CacheTemp,"/","_")

ItemNum=Clng(Trim(Request("ItemNum")))
ListNum=Clng(Trim(Request("ListNum")))
ListSuccesNum=Clng(Trim(Request("ListSuccesNum")))
ListFalseNum=Clng(Trim(Request("ListFalseNum")))
NewsNumAll=Clng(Trim(Request("NewsNumAll")))
ListPaingNext=Trim(Request("ListPaingNext"))

FoundErr=False
ItemEnd=False
ListEnd=False
CollecListNum=0
CollecNewsNum=0

Call SetCache()

If ItemEnd<>True Then
   If (ItemNum-1)>Ubound(Arr_Item,2) then
      ItemEnd=True
   Else
      Call SetItems()
   End If
End If

If ItemEnd<>True Then
   If ListPaingType=0 Then
      If ListNum=1 Then
         ListUrl=ListStr
      Else
         ListEnd=True
      End If
   ElseIf ListPaingType=1 Then
      If ListNum=1 Then
         ListUrl=ListStr
      Else
         If ListPaingNext="" or ListPaingNext="$False$" Then
            ListEnd=True
         Else
            ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
            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,"|")
      If (ListNum-1)>Ubound(ListArray) Then
         ListEnd=True
      Else
         ListUrl=ListArray(ListNum-1)
      End If    
   End If
   If ListNum>CollecListNum And CollecListNum<>0 Then
      ListEnd=True
   End if
End If

If ItemEnd=True Then
   ErrMsg="<br>列表分析完成"
   ErrMsg=ErrMsg & "<br>成功分析： "  &  ListSuccesNum  &  "  页列表,失败： "    &  ListFalseNum  &  "  页,新闻：" & NewsNumAll & "  条"
   ErrMsg=ErrMsg& "<br>正在整理数据，稍后进行新闻的采集..."
   ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Item_CollecNews.asp?ItemNum=1&NewsNum=1&NewsSuccesNum=0&NewsFalseNum=0&ImagesNumAll=0&NewsNumAll=" & NewsNumAll & """>"
Else
   If ListEnd=True Then
      ItemNum=ItemNum+1
      ListNum=1
      ErrMsg="<br>" & ItemName & "  项目所有列表分析完成，正在整理数据请稍后..."
      ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Item_CollecSteady.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&ListSuccesNum=" & ListSuccesNum & "&ListFalseNum=" & ListFalseNum & "&NewsNumAll=" & NewsNumAll & """>"
   End If
End If

Call TopItem()
If ItemEnd<>True And ListEnd<>True Then
   FoundErr=False
   ErrMsg=""
   Call StartCollection()
End  If

Response.write Cl.ShowSuc(ErrMsg)
Response.Flush()
'关闭数据库链接
Call CloseAllObj()
Call CloseConnItem()
%>

<%
'==================================================
'过程名：StartCollection
'作  用：开始采集
'参  数：无
'==================================================
Sub StartCollection

'第一次采集时登录
If LoginType=1 And ListNum=1 then
   LoginData=UrlEncoding(LoginUser & "&" & LoginPass)
   LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData)
   If Instr(LoginResult,LoginFalse)>0 Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在登录网站时发生错误，请确保登录信息的正确性！</li>"
   End If
End If

If FoundErr<>True then
   ListCode=GetHttpPage(ListUrl)
   Call GetListPaing()
   If ListCode="$False$" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在获取列表：" & ListUrl & "网页源码时发生错误！</li>"
   Else
      ListCode=GetBody(ListCode,LsString,LoString,False,False)
      If ListCode="$False$" Or ListCode="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>在截取：" & ListUrl & "的新闻列表时发生错误！</li>"
      End If
   End If
End If

If FoundErr<>True Then
   NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
   If NewsArrayCode="$False$" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & "新闻列表时发生错误！</li>"
   Else
      NewsArray=Split(NewsArrayCode,"$Array$")
      For Arr_i=0 to Ubound(NewsArray)
         If HttpUrlType=1 Then
            NewsArray(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(Arr_i)))
         Else
            NewsArray(Arr_i)=Trim(DefiniteUrl(NewsArray(Arr_i),ListUrl))           
         End If
         NewsArray(Arr_i)=CheckUrl(NewsArray(Arr_i))
      Next
      If CollecOrder=True Then
         For Arr_i=0 to Fix(Ubound(NewsArray)/2)
            OrderTemp=NewsArray(Arr_i)
            NewsArray(Arr_i)=NewsArray(Ubound(NewsArray)-Arr_i)
            NewsArray(Ubound(NewsArray)-Arr_i)=OrderTemp
         Next
      End If
   End If
End If

If FoundErr<>True Then
   ErrMsg=ErrMsg & "<br>本次运行 " & Ubound(Arr_Item,2)+1 & " 个项目"
   ErrMsg=ErrMsg & "<br>从第 " & ItemNum  & " 个项目 " & ItemName & " 的第 "  & ListNum & " 页列表分析出 " & Ubound(NewsArray) & " 条新闻"
   If CollecNewsNum<>0 Then
      ErrMsg=ErrMsg & "，限制 " & CollecNewsNum & " 条。"
      If (CollecNewsNum-1)>Ubound(NewsArray) Then
         CollecNewsNum=Ubound(NewsArray)+1
      Else
         '保持不变CollecNewsNum
      End If
   Else
      CollecNewsNum=Ubound(NewsArray)+1
   End If
   ListSuccesNum=ListSuccesNum+1
   NewsNumAll=NewsNumAll+CollecNewsNum
   Call SaveNewsList()
Else
   ListFalseNum=ListFalseNum+1
End If
ErrMsg=ErrMsg & "<br>" & "<meta http-equiv=""refresh"" content=""3;url=Item_CollecSteady.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&ListSuccesNum=" & ListSuccesNum & "&ListFalseNum=" & ListFalseNum & "&NewsNumAll=" & NewsNumAll & "&ListPaingNext=" & ListPaingNext  & """>"

End Sub


'==================================================
'过程名：SetCache
'作  用：存取缓存
'参  数：无
'==================================================
Sub SetCache()
   '项目信息
   Cl.name=CacheTemp & "items"
   If Not Cl.ObjIsEmpty then 
      Arr_Item=Cl.value
   Else
      ItemEnd=True
   End If
End Sub

Sub SetItems() 
      Dim ItemNumTemp
      ItemNumTemp=ItemNum-1
      ItemID=Arr_Item(0,ItemNumTemp)
      ItemName=Arr_Item(1,ItemNumTemp)
      LoginType=Arr_Item(9,ItemNumTemp)
      LoginUrl=Arr_Item(10,ItemNumTemp)          '登录
      LoginPostUrl=Arr_Item(11,ItemNumTemp)
      LoginUser=Arr_Item(12,ItemNumTemp)
      LoginPass=Arr_Item(13,ItemNumTemp)
      LoginFalse=Arr_Item(14,ItemNumTemp)
      ListStr=Arr_Item(15,ItemNumTemp)            '列表地址
      LsString=Arr_Item(16,ItemNumTemp)          '列表
      LoString=Arr_Item(17,ItemNumTemp)
      ListPaingType=Arr_Item(18,ItemNumTemp)
      LPsString=Arr_Item(19,ItemNumTemp)          
      LPoString=Arr_Item(20,ItemNumTemp)
      ListPaingStr1=Arr_Item(21,ItemNumTemp)
      ListPaingStr2=Arr_Item(22,ItemNumTemp)
      ListPaingID1=Arr_Item(23,ItemNumTemp)
      ListPaingID2=Arr_Item(24,ItemNumTemp)
      ListPaingStr3=Arr_Item(25,ItemNumTemp)
      HsString=Arr_Item(26,ItemNumTemp)  
      HoString=Arr_Item(27,ItemNumTemp)
      HttpUrlType=Arr_Item(28,ItemNumTemp)
      HttpUrlStr=Arr_Item(29,ItemNumTemp)
      CollecListNum=Arr_Item(80,ItemNumTemp)
      CollecNewsNum=Arr_Item(81,ItemNumTemp)
      CollecOrder=Arr_Item(84,ItemNumTemp)
End Sub

'==================================================
'过程名：GetListPaing
'作  用：获取列表下一页
'参  数：无
'==================================================
Sub GetListPaing()
   If ListPaingType=1 Then
      ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
      ListPaingNext=HtmlEnCode(ListPaingNext)
      If ListPaingNext<>"$False$" And ListPaingNext<>"" Then
         If ListPaingStr1<>""  Then  
            ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
         Else
            ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
         End If
         ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
      End If
   Else
      ListPaingNext="$False$"
   End If
End Sub

'==================================================
'过程名：SaveNewsList
'作  用：保存文章
'参  数：无
'==================================================
Sub SaveNewsList
   set rs=server.createobject("adodb.recordset")
   sql="select top 1 * from NewsList" 
   rs.open sql,connItem,1,3
   For Arr_i=1 To CollecNewsNum
      rs.addnew
      rs("ItemID")=ItemID
      rs("NewsUrl")=NewsArray(Arr_i-1)
      rs.update
   Next
   rs.close
   set rs=Nothing
End Sub

'==================================================
'过程名：TopItem
'作  用：显示导航信息
'参  数：无
'==================================================
Sub TopItem()%>
<table width="100%" border="0" align="center" cellpadding="2" cellspacing="1" class="border">
  <tr class="title"> 
    <td height="22" colspan="2" align="center" class="topbg"><strong>采 集 系 统 采 集 管 理</strong></td>
  </tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr class="tdbg"> 
    <td width="65" height="30"><strong>管理导航：</strong></td>
    <td height="30"><a href="Item_Start.asp">管理首页</a> >> 列表分析</td>         
  </tr>  
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">       
  <tr> 
    <td height="22" colspan="2" class="tdbg" aling="center">采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集正常结束后即可恢复。
    </td>
  </tr>
</table>
<%End Sub%>
</body>
</html>