admin_itemcollecfast.asp

用ASP开发环境写出来的新闻采集系统

      SaveFiles=Arr_Item(83,ItemNumTemp)
      CollecOrder=Arr_Item(84,ItemNumTemp)
      LinkUrlYn=Arr_Item(85,ItemNumTemp)
      InputerType=Arr_Item(86,ItemNumTemp)
      Inputer=Arr_Item(87,ItemNumTemp)
      EditorType=Arr_Item(88,ItemNumTemp)
      Editor=Arr_Item(89,ItemNumTemp)
      ShowCommentLink=Arr_Item(90,ItemNumTemp)
      Script_Table=Arr_Item(91,ItemNumTemp)
      Script_Tr=Arr_Item(92,ItemNumTemp)
      Script_Td=Arr_Item(93,ItemNumTemp)

      If InputerType=1 Then
         Inputer=FpHtmlEnCode(Inputer)
      Else
         Inputer=session("AdminName")
      End If
      If EditorType=1 Then
         Editor=FpHtmlEnCode(Editor)
      Else
         Editor=session("AdminName")
      End If
      If IsObjInstalled("Scripting.FileSystemObject")=False or strChannelDir="" Then
         SaveFiles=False
      End if
End Sub

'==================================================
'过程名：GetListPaing
'作  用：获取列表下一页
'参  数：无
'==================================================
Sub GetListPaing()
   If ListPaingType=1 Then
      ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
      ListPaingNext=FpHtmlEnCode(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

'==================================================
'过程名：SaveArticle
'作  用：保存文章
'参  数：无
'==================================================
Sub SaveArticle
   If ArticleID=0 Then
      set rs=server.createobject("adodb.recordset")
      sql="select top 1 ArticleID from PE_Article order by ArticleID desc" 
      rs.open sql,conn,1,1
      If rs.eof and rs.bof then
         ArticleID=1
      Else
         ArticleID=rs("ArticleID")+1
      End If
      rs.close
      set rs=nothing
   Else
      ArticleID=ArticleID+1
   End If
   set rs=server.createobject("adodb.recordset")
   sql="select top 1 * from PE_Article" 
   rs.open sql,conn,1,3
   rs.addnew
   rs("ArticleID")=ArticleID
   rs("ChannelID")=ChannelID
   rs("ClassID")=ClassID
   rs("SpecialID")=SpecialID
   rs("Title")=Title
   rs("TitleFontType")=0
   If LinkUrlYn=False Then
      rs("Content")=Content
   Else
      rs("Content")=""
      rs("LinkUrl")=NewsUrl
   End If
   rs("Keyword")=Key
   rs("Hits")=Hits
   rs("Author")=Author
   rs("CopyFrom")=CopyFrom
   rs("IncludePic")=IncludePic
   rs("Passed")=0
   rs("OnTop")=OnTop
   rs("Hot")=Hot
   rs("Elite")=Elite
   rs("Stars")=Stars
   rs("UpdateTime")=UpDateTime
   rs("PaginationType")=PaginationType
   rs("MaxCharPerPage")=MaxCharPerPage
   rs("ReadLevel")=ReadLevel
   rs("ReadPoint")=ReadPoint
   rs("SkinID")=SkinID
   rs("TemplateID")=TemplateID
   rs("DefaultPicUrl")=DefaultPicUrl
   rs("UploadFiles")=UploadFiles
   rs("ShowCommentLink")=ShowCommentLink
   rs("Inputer")=Inputer
   if Editor="" then Editor="五月"
   rs("Editor")=Editor
   rs.update
   rs.close
   set rs=nothing
End Sub


'==================================================
'过程名：Filters
'作  用：过滤
'==================================================
Sub Filters()
If IsNull(Arr_Filters)=True or IsArray(Arr_Filters)=False Then
   Exit Sub
End if

   For Filteri=0 to Ubound(Arr_Filters,2)
      FilterStr=""
      If Arr_Filters(1,Filteri)=ItemID Or Arr_Filters(10,Filteri)=True Then
         If Arr_Filters(3,Filteri)=1 Then'标题过滤
            If Arr_Filters(4,Filteri)=1 Then
               Title=Replace(Title,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
            ElseIf Arr_Filters(4,Filteri)=2 Then
               FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Do While FilterStr<>"$False$"
                  Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
                  FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Loop
            End If
         ElseIf Arr_Filters(3,Filteri)=2 Then'正文过滤
            If Arr_Filters(4,Filteri)=1 Then
               Content=Replace(Content,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
            ElseIf Arr_Filters(4,Filteri)=2 Then
               FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Do While FilterStr<>"$False$"
                  Content=Replace(Content,FilterStr,Arr_Filters(8,Filteri))
                  FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Loop
            End If
         End If
      End If
   Next
End Sub

'==================================================
'过程名：FilterScript
'作  用：脚本过滤
'==================================================

Sub  FilterScript()
   If Script_Iframe=True Then
      Content=ScriptHtml(Content,"Iframe",1)
   End If
   If Script_Object=True Then
      Content=ScriptHtml(Content,"Object",2)
   End If
   If Script_Script=True Then
      Content=ScriptHtml(Content,"Script",2)
   End If
   If Script_Div=True Then
      Content=ScriptHtml(Content,"Div",3)
   End If
   If Script_Table=True Then
      Content=ScriptHtml(Content,"table",3)
   End If
   If Script_Tr=True Then
      Content=ScriptHtml(Content,"tr",3)
   End If
   If Script_Td=True Then
      Content=ScriptHtml(Content,"td",3)
   End If
   If Script_Span=True Then
      Content=ScriptHtml(Content,"Span",3)
   End If
   If Script_Img=True Then
      Content=ScriptHtml(Content,"Img",3)
   End If
   If Script_Font=True Then
      Content=ScriptHtml(Content,"Font",3)
   End If
   If Script_A=True Then
      Content=ScriptHtml(Content,"A",3)
   End If
   If Script_Html=True Then
      Content=noHtml(Content)
   End If
End  Sub

'==================================================
'过程名：TopItem
'作  用：显示导航信息
'参  数：无
'==================================================
Sub TopItem()%>
<html>
<head>
<title>新闻采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="Admin_Style.css">
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr> 
    <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="Admin_ItemStart.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%>

<%
Sub TopItem2%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
    <tr>
      <td height="22" colspan="2" class="tdbg" aling="left">本次运行：<%=Ubound(Arr_Item,2)+1%> 个项目,正在采集第 <font color=red><%= ItemNum%></font> 个项目  <font color=red><%=ItemName%></font>  的第   <font color=red><%=ListNum%></font> 页列表,该列表待采集新闻  <font color=red><%=Ubound(NewsArray)+1%></font> 条。
      <%if CollecNewsNum<>0 Then Response.Write "限制 <font color=red>" & CollecNewsNum & "</font> 条。"%>
      <br>采集统计：成功采集--<%=NewsSuccesNum%>  条新闻，失败--<%=NewsFalseNum%>  条，图片--<%=ImagesNumAll%>　张。<a href="Admin_ItemStart.asp">停止采集</a>
      </td>
    </tr>
</table>
<%StartTime=Timer()%>
<%End Sub%>

<%
'==================================================
'过程名：FootItem
'作  用：显示底部版权等信息
'参  数：无
'==================================================
Sub FootItem()%>
<!--#include file="Admin_ItemFoot.asp"-->       
</body>         
</html>
<%End Sub%>

<%
'==================================================
'过程名：FootItem2
'作  用：显示该列表采集时间等信息
'参  数：无
'==================================================
Sub FootItem2()
   Dim strTemp
   OverTime=Timer()
   strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"       
   strTemp=strTemp & "<tr>"          
   strTemp=strTemp & "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
   strTemp=strTemp & "执行时间：" & CStr(FormatNumber((OverTime-StartTime)*1000,2)) & " 毫秒"
   strTemp=strTemp & "</td></tr><br>"
   strTemp=strTemp & "</table>"
   Response.write strTemp
End Sub

'==================================================
'过程名：ShowMsg
'作  用：显示信息
'参  数：无
'==================================================
Sub ShowMsg(Msg)
   Dim strTemp
   strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"       
   strTemp=strTemp & "   <tr class='tdbg'>"          
   strTemp=strTemp & "      <td height=""22"" colspan=""2"" align=""left"">"
   strTemp=strTemp & Msg
   strTemp=strTemp & "      </td>"
   strTemp=strTemp & "   </tr><br>"
   strTemp=strTemp & "</table>"
   Response.Write StrTemp     
End Sub

Function CheckRepeat(strUrl)
   CheckRepeat=False
   If IsArray(Arr_Histrolys)=True then
      For His_i=0 to Ubound(Arr_Histrolys,2)
         If Arr_Histrolys(0,His_i)=strUrl Then
            CheckRepeat=True
            His_Title=Arr_Histrolys(1,His_i)
            His_CollecDate=Arr_Histrolys(2,His_i)
            His_Result=Arr_Histrolys(3,His_i)
            Exit For
         End If
      Next
   End If
End Function

Sub SetCache_His()
   '历史记录
   SqlItem ="select NewsUrl,Title,CollecDate,Result from Histroly"
   Set RsItem=Server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,1
   If Not RsItem.Eof Then
      Arr_Histrolys=RsItem.GetRows()
   End If
   RsItem.Close
   Set RsItem=Nothing

   Dim myCache
   Set myCache=new clsCache
   myCache.name=CacheTemp & "histrolys"
   Call myCache.clean()
   If IsArray(Arr_Histrolys)=True Then   
      myCache.add Arr_Histrolys,Dateadd("n",1000,now)
   End If
End Sub
%>