<!--#include file="../../fy.Function.asp"-->
<!--#include file="conn.asp"-->
<!--#include file="inc/function.asp"-->
<!--#include file="inc/ubbcode.asp"-->
<!--#include file="inc/clsCache.asp"-->
<!--#include file="../../../fy_inc/Escape.asp"-->
<!--#include file="../../../fy_inc/CreateView.asp"-->
<%
Response.Buffer = True
Server.ScriptTimeout = 9999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"

Dim ItemNum,ListNum,PaingNum,NewsSuccesNum,NewsFalseNum
Dim Rs,Sql,RsItem,SqlItem,FoundErr,ErrMsg,ItemEnd,ListEnd

'项目变量
Dim ItemID,ItemName,ClassID,strCharsetCode,SpecialID,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr,CharsetCode
Dim TsString,ToString,CsString,CoString,DateType,DsString,DoString,AuthorType,AsString,AoString,AuthorStr,CopyFromType,FsString,FoString
Dim CopyFromStr,KeyType,KsString,KoString,KeyStr,NewsPaingType,NPsString,NpoString,NewsPaingStr,NewsPaingHtml
Dim ItemCollecDate,PaginationType,MaxCharPerPage,ReadLevel,Stars,ReadPoint,Hits,UpDateType,addtime,IncludePicYn,DefaultPicYn,OnTop,Elite,Hot
Dim SkinID,TemplateID,Script_Iframe,Script_Object,Script_Script,Script_Div,Script_Class,Script_Span,Script_Img,Script_Font,Script_A,Script_Html,CollecListNum,CollecNewsNum,Passed,SaveFiles,CollecOrder,LinkUrlYn,InputerType,Inputer,EditorType,Editor,ShowCommentLink,Script_Table,Script_Tr,Script_Td,Script_Tbody

'过滤变量
Dim Arr_Filters,FilterStr,Filteri

'采集相关的变量
Dim ContentTemp,NewsPaingNext,NewsPaingNextCode,Arr_i,NewsUrl,NewsCode

'文章保存变量
Dim ArticleID,Title,Content,Author,CopyFrom,Key,IncludePic,UploadFiles,DefaultPicUrl

'其它变量
Dim LoginData,LoginResult,OrderTemp
Dim Arr_Item,CollecTest,CollecNewsAll
Dim StepID

'历史记录
Dim Arr_Histrolys,His_Title,His_CollecDate,His_Result,His_Repeat,His_i 

'执行时间变量
Dim StartTime,OverTime

'图片统计
Dim Arr_Images,ImagesNum,ImagesNumAll

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

'安装路径
Dim strInstallDir,CacheTemp
strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
'strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/"))
'缓存路径
CacheTemp=Lcase(trim(request.ServerVariables("SCRIPT_NAME")))
CacheTemp=left(CacheTemp,instrrev(CacheTemp,"/"))
CacheTemp=replace(CacheTemp,"\","_")
CacheTemp=replace(CacheTemp,"/","_")
CacheTemp="CacheName" & CacheTemp

'数据初始化
CollecListNum=0
CollecNewsNum=0
ArticleID=0
ItemNum=Clng(Trim(Request("ItemNum")))
ListNum=Clng(Trim(Request("ListNum")))
NewsSuccesNum=Clng(Trim(Request("NewsSuccesNum")))
NewsFalseNum=Clng(Trim(Request("NewsFalseNum")))
ImagesNumAll=Clng(Trim(Request("ImagesNumAll")))
ListPaingNext=Trim(Request("ListPaingNext"))
FoundErr=False
ItemEnd=False
ListEnd=False
ErrMsg=""
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>成功采集： "  &  NewsSuccesNum  &  "  条,失败： "    &  NewsFalseNum  &  "  条,图片：" & ImagesNumAll & "  张"
   Call DelCache()
Else
   If ListEnd=True Then
      ItemNum=ItemNum+1
      ListNum=1
      ErrMsg="<br>" & ItemName & "  项目所有列表采集完成，正在整理数据请稍后..."
      ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=collectfun.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & """>"
   End If
End If

Call TopItem()
If ItemEnd=True Or ListEnd=True Then
   If ItemEnd<>True Then
      Call SetCache_His()
   End If
   Call WriteSucced(ErrMsg)
Else
   FoundErr=False
   ErrMsg=""
   Call StartCollection()
   Call FootItem2()
End  If
 Response.Flush()
'关闭数据库链接
Call CloseConn()
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,CharsetCode)
   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
   Call TopItem2()
   CollecNewsAll=0
   For Arr_i=0 to Ubound(NewsArray)
      If CollecNewsAll>=CollecNewsNum And CollecNewsNum<>0 Then
         Exit For
      End If
      CollecNewsAll=CollecNewsAll+1
      '变量初始化
      UploadFiles=""
      DefaultPicUrl=""
      IncludePic=0
      ImagesNum=0
      NewsCode=""
      FoundErr=False
      ErrMsg=""
      His_Repeat=False
      NewsUrl=NewsArray(Arr_i)
      Title=""
      PaingNum=1
      '……………………………………………… 
      If Response.IsClientConnected Then 
         Response.Flush 
      Else 
         Response.End 
      End If
      '……………………………………………… 
       If CollecTest=False Then
         His_Repeat=CheckRepeat(NewsUrl)
      Else
         His_Repeat=False
      End If
      If His_Repeat=True Then
         FoundErr=True
      End If

      If FoundErr<>True Then
         NewsCode=GetHttpPage(NewsUrl,CharsetCode)
         If NewsCode="$False$" Then
            FoundErr=True
            ErrMsg=ErrMsg & "<br>在获取：" & NewsUrl & "文章源码时发生错误！"
            Title="获取网页源码失败"
         End If
      End If


	
      If FoundErr<>True Then

 		'开始自定义字段采集


         Title=GetBody(NewsCode,TsString,ToString,False,False)
         If Title="$False$" or Title="" then
            FoundErr=True
            ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的文章标题时发生错误"
            Title="<br>标题分析错误" 
         End If
         If FoundErr<>True Then
            Content=GetBody(NewsCode,CsString,CoString,False,False)
            If Content="$False$" or Content="" Then
               FoundErr=True
               ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的文章正文时发生错误"
               Title=Title & "<br>正文分析错误" 
            End If
         End If
         If FoundErr<>True Then
            '文章分页
            If NewsPaingType=1 Then
               NewsPaingNext=GetPaing(NewsCode,NPsString,NPoString,False,False)
               NewsPaingNext=FpHtmlEnCode(NewsPaingNext)
               Do While NewsPaingNext<>"$False$" And NewsPaingNext<>""
                  If NewsPaingStr="" or IsNull(NewsPaingStr)=True Then
                     NewsPaingNext=DefiniteUrl(NewsPaingNext,NewsUrl)
                  Else
                     NewsPaingNext=Replace(NewsPaingStr,"{$ID}",NewsPaingNext)
                  End If
                  If NewsPaingNext="" or NewsPaingNext="$False$" Then
                     Exit Do
                  End If
                  NewsPaingNextCode=GetHttpPage(NewsPaingNext,CharsetCode)                  
                  ContentTemp=GetBody(NewsPaingNextCode,CsString,CoString,False,False)
                  If ContentTemp="$False$" Then
                     Exit Do
                  Else
                     PaingNum=PaingNum+1
                     'Content=Content & NewsPaingHtml & ContentTemp
					IF PaginationType=2 Then
					Content = Content & fengyename & ContentTemp
					Else
					Content = Content & ContentTemp
					End IF
                     NewsPaingNext=GetPaing(NewsPaingNextCode,NPsString,NPoString,False,False)
                     NewsPaingNext=FpHtmlEnCode(NewsPaingNext)
					 
                  End If
               Loop
            End If
            '过滤
            Call Filters
            Title=FpHtmlEnCode(Title)
            Call FilterScript()
            Content=Ubbcode(Content)
         End If
      End If

       If FoundErr<>True Then
         '时间
         If UpDateType=0 Then
            addtime=Now()
         ElseIf UpDateType=1 Then
            'If DateType=0 then
              ' addtime=Now()
            'Else
               addtime=GetBody(NewsCode,DsString,DoString,False,False)
               addtime=FpHtmlEncode(addtime)
               addtime=Trim(Replace(addtime,"&nbsp;"," "))
               If IsDate(addtime)=True Then
                  addtime=CDate(addtime)
               Else
                  addtime=Now()
               End If
            'End If
         ElseIf UpDateType=2 Then  
		 	addtime=addtime
         Else
            addtime=Now()
         End If
                  
         '作者
         If AuthorType=1 Then
            Author=GetBody(NewsCode,AsString,AoString,False,False)
         ElseIf AuthorType=2 Then
            Author=AuthorStr
         Else
            Author="佚名"
         End If
         Author=FpHtmlEncode(Author)
         If Author="" or Author="$False$" then
            Author="佚名"
         Else
            If Len(Author)>255 then
               Author=Left(Author,255)
            End If
         End If
           
         '来源
         If CopyFromType=1 Then
            CopyFrom=GetBody(NewsCode,FsString,FoString,False,False)
         ElseIf CopyFromType=2 Then
            CopyFrom=CopyFromStr
         Else
            CopyFrom="不详"
         End If
         CopyFrom=FpHtmlEncode(CopyFrom)
         If CopyFrom="" or CopyFrom="$False$" Then
	            CopyFrom="不详"
         Else
            If Len(CopyFrom)>255 Then 
               CopyFrom=Left(CopyFrom,255)
            End If
         End If

         '关键字
         If KeyType=0 Then
            Key=Title
			Key=CreateKeyWord(Key,2)
		 ElseIf KeyType=3 Then
 			Dim WS:Set WS=New Wordsegment_Cls
			Key = WS.SplitKey(title,4,20)
         ElseIf KeyType=1 Then
            Key=GetBody(NewsCode,KsString,KoString,False,False)
            Key=FpHtmlEncode(Key)
            Key=CreateKeyWord(Key,12)
         ElseIf KeyType=2 Then
            Key=KeyStr
            Key=FpHtmlEncode(Key)
            If Len(Key)>253 Then
               Key=Left(Key,253)
            Else
               Key=Key
            End If
         End If
         If Key="" or Key="$False$" Then
            Key=Title
         End If
         
         '转换图片相对地址为绝对地址/保存
         If CollecTest=False And SaveFiles=True then
            Content=ReplaceSaveRemoteFile(Content,strInstallDir,strCharsetCode,True,NewsUrl,classid)              
         Else
            Content=ReplaceSaveRemoteFile(Content,strInstallDir,strCharsetCode,False,NewsUrl,classid)
         End If
         '转换swf文件地址
         Content=ReplaceSwfFile(Content,NewsUrl)
  
         '图片统计、文章图片属性设置
         If UploadFiles<>"" Then
            If Instr(UploadFiles,"|")>0 Then
               Arr_Images=Split(UploadFiles,"|") 
               ImagesNum=Ubound(Arr_Images)+1
               DefaultPicUrl=Arr_Images(0)
            Else
               ImagesNum=1
               DefaultPicUrl=UploadFiles
            End If

            If DefaultPicYn=False then
               DefaultPicUrl=""
            End If
            If IncludePicYn=True Then
               IncludePic=-1
            Else
               IncludePic=0
            End If
            If SaveFiles<>True Then
               UploadFiles=""
            End If
         Else
            ImagesNum=0
            DefaultPicUrl=""
            IncludePic=0         
         End If
         ImagesNumAll=ImagesNumAll+ImagesNum
      End If

      If FoundErr<>True Then
         If CollecTest=False Then
            Call SaveArticle
			'On Error Resume Next 
            SqlItem="INSERT INTO Histroly(ItemID,ClassID,SpecialID,ArticleID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & left(Title,100) & "','" & Now() & "','" & NewsUrl & "',True)"
            ConnItem.Execute(SqlItem)
          End If
         NewsSuccesNum=NewsSuccesNum+1
         ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
         ErrMsg=ErrMsg & "文章标题："
         ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
         ErrMsg=ErrMsg & "更新时间：" & addtime & "<br>"
         ErrMsg=ErrMsg & "文章作者：" & Author & "<br>"
         ErrMsg=ErrMsg & "文章来源：" & CopyFrom & "<br>"
         ErrMsg=ErrMsg & "采集页面：<a href=" & NewsUrl & " target=_blank>" & NewsUrl & "</a><br>"
         ErrMsg=ErrMsg & "其它信息2：分页--" & PaingNum & " 页，图片--" & ImagesNum & " 张<br>"
         ErrMsg=ErrMsg & "正文预览1："

			ErrMsg=""

			ErrMsg=ErrMsg&"<table width='99%'  border='0' align=center cellpadding='0' cellspacing='1' class=table>"
			ErrMsg=ErrMsg&"         <TR class=bg_tr>"
			ErrMsg=ErrMsg&"          <td width=5%   align=center  class=bg_tr>选择</td>"
 			ErrMsg=ErrMsg&"          <td width=25% align=center  class=bg_tr>文章标题</td>"
			ErrMsg=ErrMsg&"         <td width=15% align=center  class=bg_tr>更新时间</td>"
			ErrMsg=ErrMsg&"          <td width=5% align=center  class=bg_tr>作者</td>"
			ErrMsg=ErrMsg&"          <td width=5% align=center  class=bg_tr>来源</td>"
			ErrMsg=ErrMsg&"          <td width=5% align=center  class=bg_tr>采集页面</td>"
			ErrMsg=ErrMsg&"          <td width=15% align=center  class=bg_tr>其他</td>"
			ErrMsg=ErrMsg&"    </TR>"
			 
			ErrMsg=ErrMsg&"	<tr >"
			ErrMsg=ErrMsg&"          <td align=center>第<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font>条</td>"
 			ErrMsg=ErrMsg&"          <td align=center><font color=red>" & Title & "</font></td>"
			ErrMsg=ErrMsg&"          <td align=center>"&addtime&"</td>"
			ErrMsg=ErrMsg&"          <td align=center><b> " & Author & " </b> </td>"
			ErrMsg=ErrMsg&"          <td align=center>" & CopyFrom & " </td>"
			ErrMsg=ErrMsg&"          <td align=center><a href=" & NewsUrl & " target=_blank>" & NewsUrl & "</a></td>"

			ErrMsg=ErrMsg&"          <td align=center><b> 分页--" & PaingNum & " 页，图片--" & ImagesNum & " 张 </b> </td>"
			
			ErrMsg=ErrMsg&"   </TR>"
					
			ErrMsg=ErrMsg&" </TABLE>"

          ErrMsg=ErrMsg & "<br><br>关 键 字：" & Key & ""
		 Call InnerJS(Arr_I,UBound(NewsArray)+1,ErrMsg)

      Else
         NewsFalseNum=NewsFalseNum+1
         If His_Repeat=True Then
            ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
            ErrMsg=ErrMsg & "目标文章：<font color=red>"
            If His_Result=True Then
               ErrMsg=ErrMsg & His_Title
            Else
               ErrMsg=ErrMsg & NewsUrl
            End If
            ErrMsg=ErrMsg & "</font> 的记录已存在，不给予采集。<br>"
            ErrMsg=ErrMsg & "采集时间：" & His_CollecDate & "<br>"
            ErrMsg=ErrMsg & "文章来源：<a href='" & NewsUrl & "' target=_blank>"&NewsUrl&"</a><br>"
            ErrMsg=ErrMsg & "采集结果："
            If His_Result=False Then
               ErrMsg=ErrMsg & "失败"
               ErrMsg=ErrMsg & "<br>失败原因：" & Title
            Else
               ErrMsg=ErrMsg & "成功"
            End If            
            ErrMsg=ErrMsg & "<br>提示信息：如想再次采集，请先将该文章的历史记录<font color=red>删除</font> "
         End If
         If CollecTest=False And His_Repeat=False Then
		 	On Error Resume Next
            SqlItem="INSERT INTO Histroly(ItemID,ClassID,SpecialID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ClassID & "','" & SpecialID & "','" & left(Title,100) & "','" & Now() & "','" & NewsUrl & "',False)"
			echo SqlItem
            ConnItem.Execute(SqlItem)
         End If
          Call ShowMsg(ErrMsg)
      Response.Flush()'刷新
	  End If
   Next
Else
   Call ShowMsg(ErrMsg)
End If

 



 
End Sub

		
		Sub InnerJS(NowNum,TotalNum,msg)
		  msg=Replace(Replace(Replace(msg, Chr(13) & Chr(10), ""),"'","\'"),"""","\""")
 

 

				echo "<script>"
				echo "fsohtml.innerHTML='" & msg & "';" & vbCrLf
				echo "img2.width=" & Fix((NowNum / TotalNum) * 400) & ";" & vbCrLf
				echo "txt2.innerHTML=""采集进度:" & FormatNumber(NowNum / TotalNum * 100, 2, -1) & """;" & vbCrLf
				echo "txt3.innerHTML=""<table width='800'  border='0' align=center cellpadding='0' cellspacing='0' class=table><TR > <TR ><td width=5% align=center>正在采集第 <font color=red>" & ItemNum & "</font> 个项目的第   <font color=red>" & ListNum & "</font> 页列表,本页需要采集 <font color=red><b>" & TotalNum & "</b></font> 条数据,<font color=red><b>在此过程中请勿刷新此页面！！！</b></font> 系统正在采集第 <font color=red><b>" & NowNum & "</b></font> 条</td> </TR></TABLE>"";" & vbCrLf
				echo "img2.title=""(" & NowNum & ")"";</script>" & vbCrLf
		
		 


 		 response.Flush

		End Sub


'==================================================
'过程名：SetCache
'作  用：存取缓存
'参  数：无
'==================================================
Sub SetCache()
   Dim myCache
   Set myCache=new clsCache

   '项目信息
   myCache.name=CacheTemp & "items"
   If myCache.valid then 
      Arr_Item=myCache.value
    Else
      ItemEnd=true
    End If
	
   '过滤信息
   myCache.name=CacheTemp & "filters"
   If myCache.valid then 
      Arr_Filters=myCache.value
   End If

   '历史记录
   myCache.name=CacheTemp & "histrolys"
   If myCache.valid then 
      Arr_Histrolys=myCache.value
   End If

   '其它信息
   myCache.name=CacheTemp & "collectest"
   If myCache.valid then 
      CollecTest=myCache.value
   Else
      CollecTest=False
   End If
 

   Set myCache=Nothing
End Sub

Sub DelCache() 
   Dim myCache
   Set myCache=new clsCache
   myCache.name=CacheTemp & "items"
   Call myCache.clean()
   myCache.name=CacheTemp & "filters"
   Call myCache.clean()
   myCache.name=CacheTemp & "histrolys"
   Call myCache.clean()
   myCache.name=CacheTemp & "collectest"
   Call myCache.clean()
    Set myCache=Nothing
End Sub

'==================================================
'过程名：SetItems
'作  用：获取项目信息
'参  数：无
'==================================================
Sub SetItems()
      Dim ItemNumTemp
      ItemNumTemp=ItemNum-1
      ItemID=Arr_Item(0,ItemNumTemp)
      ItemName=Arr_Item(1,ItemNumTemp)
      ClassID=Arr_Item(2,ItemNumTemp)'栏目ID
      CharsetCode=Arr_Item(3,ItemNumTemp)'栏目目录
      ClassID=Arr_Item(4,ItemNumTemp)            '栏目
      SpecialID=Arr_Item(5,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)
      TsString=Arr_Item(30,ItemNumTemp)          '标题
      ToString=Arr_Item(31,ItemNumTemp)
      CsString=Arr_Item(32,ItemNumTemp)          '正文
      CoString=Arr_Item(33,ItemNumTemp)
      DateType=Arr_Item(34,ItemNumTemp)      '作者
      DsString=Arr_Item(35,ItemNumTemp)          
      DoString=Arr_Item(36,ItemNumTemp)
      AuthorType=Arr_Item(37,ItemNumTemp)      '作者
      AsString=Arr_Item(38,ItemNumTemp)          
      AoString=Arr_Item(39,ItemNumTemp)
      AuthorStr=Arr_Item(40,ItemNumTemp)
      CopyFromType=Arr_Item(41,ItemNumTemp)  '来源
      FsString=Arr_Item(42,ItemNumTemp)          
      FoString=Arr_Item(43,ItemNumTemp)
      CopyFromStr=Arr_Item(44,ItemNumTemp)
      KeyType=Arr_Item(45,ItemNumTemp)            '关键词
      KsString=Arr_Item(46,ItemNumTemp)          
      KoString=Arr_Item(47,ItemNumTemp)
      KeyStr=Arr_Item(48,ItemNumTemp)
      NewsPaingType=Arr_Item(49,ItemNumTemp)            '关键词
      NPsString=Arr_Item(50,ItemNumTemp)          
      NPoString=Arr_Item(51,ItemNumTemp)
      NewsPaingStr=Arr_Item(52,ItemNumTemp)
      NewsPaingHtml=Arr_Item(53,ItemNumTemp)
      PaginationType=Arr_Item(55,ItemNumTemp)
      MaxCharPerPage=Arr_Item(56,ItemNumTemp)
      ReadLevel=Arr_Item(57,ItemNumTemp)
      Stars=Arr_Item(58,ItemNumTemp)
      ReadPoint=Arr_Item(59,ItemNumTemp)
      Hits=Arr_Item(60,ItemNumTemp)
      UpDateType=Arr_Item(61,ItemNumTemp)
      addtime=Arr_Item(62,ItemNumTemp)
      IncludePicYn=Arr_Item(63,ItemNumTemp)
      DefaultPicYn=Arr_Item(64,ItemNumTemp)
      OnTop=Arr_Item(65,ItemNumTemp)
      Elite=Arr_Item(66,ItemNumTemp)
      Hot=Arr_Item(67,ItemNumTemp)
      SkinID=Arr_Item(68,ItemNumTemp)
      TemplateID=Arr_Item(69,ItemNumTemp)
      Script_Iframe=Arr_Item(70,ItemNumTemp)
      Script_Object=Arr_Item(71,ItemNumTemp)
      Script_Script=Arr_Item(72,ItemNumTemp)
      Script_Div=Arr_Item(73,ItemNumTemp)
      Script_Class=Arr_Item(74,ItemNumTemp)
      Script_Span=Arr_Item(75,ItemNumTemp)
      Script_Img=Arr_Item(76,ItemNumTemp)
      Script_Font=Arr_Item(77,ItemNumTemp)
      Script_A=Arr_Item(78,ItemNumTemp)
      Script_Html=Arr_Item(79,ItemNumTemp)
      CollecListNum=Arr_Item(80,ItemNumTemp)
      CollecNewsNum=Arr_Item(81,ItemNumTemp)
      Passed=Arr_Item(82,ItemNumTemp)
      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)
	  Script_Tbody=Arr_Item(94,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 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
   Dim ModeID
   ModeID=fycms.ACT_L(getclassid(ItemID),10)
    Set  rs=server.createobject("adodb.recordset")


	Dim strFileName,ChkFileName
	strFileName=fycms.ACT_L(ClassID,16)
	If Instr(strFileName,"{y}") > 0 Then strFileName = Replace(strFileName,"{y}",Right("0" & Year(Now), 2))
	If Instr(strFileName,"{yy}") > 0 Then strFileName = Replace(strFileName,"{yy}", Year(Now))
	If Instr(strFileName,"{time}") > 0 Then strFileName = Replace(strFileName,"{time}", hour(time))
	If Instr(strFileName,"{m}") > 0 Then strFileName = Replace(strFileName,"{m}",Right("0" & Month(Now), 2))
	If Instr(strFileName,"{d}") > 0 Then strFileName = Replace(strFileName,"{d}",Right("0" & Day(Now), 2))
	If Instr(strFileName,"{date}") > 0 Then strFileName = Replace(strFileName,"{date}",Year(Now) & "-" & Month(Now) & "-" & Day(Now))
	If Instr(strFileName,"{enname}") > 0 Then strFileName = Replace(strFileName,"{enname}",fycms.ACT_L(classid,3))
	If Instr(strFileName,"{md5}") > 0 Then strFileName = Replace(strFileName,"{md5}",MD5(Now,32))
	If Instr(strFileName,"{rnd}") > 0 Then strFileName = Replace(strFileName,"{rnd}",fycms.GetRandomize(10))
	If Instr(strFileName,"{pinyin}") > 0 Then strFileName = Replace(strFileName,"{pinyin}",fycms.GetEn(fycms.PinYin(delhtml(Title))))
	If Right(strFileName,1)="/" Then 
		strFileName=Left(strFileName, Len(strFileName) - 1)
	End If 

	If InStr(strFileName, "//") > 0   Then
		strFileName = Replace(strFileName, "//","/")
	End If 
	
	set ChkFileName = conn.execute("select ID From "&fycms.ACT_C(ModeID,2)&" where ClassID="& ClassID &" and FileName='"& strFileName &"'   order by ID desc")
	if Not ChkFileName.eof then
		Exit Sub 
		Response.end
	End If








   sql="select top 1 * from  "&fycms.ACT_C(ModeID,2)&"" 
 '  sql="select top 1 * from  Article" 
   
   rs.open sql,conn,1,3
   'On Error Resume Next
   'startString
   'endString
    rs.addnew

 	Dim FieldContent,i
	FieldContent=getField(ModeID,ItemID)
	If IsArray(FieldContent) Then
	For I=0 To Ubound(FieldContent,2)
  		Select Case  FieldContent(0,I)
			Case "1"
				rs(FieldContent(3,I)) = GetBody(NewsCode,FieldContent(1,I),FieldContent(2,I),False,False)
 			Case "2"'指定
 				rs(FieldContent(3,I)) = FieldContent(5,I)
 		End Select 
 	Next
	End If 


  rs("FileName") = strFileName'文件名
   rs("ClassID")=ClassID
   rs("Title")=Left(Title,100)
   rs("Keywords")=Left(Key,50)
   rs("Hits")=Hits
   rs("Author")=Left(Author,10)
   rs("CopyFrom")=Left(CopyFrom,10)
   If fycms.ACT_C(modeid,18)="0" Then  	rs("Content") = Content'内容

    rs("actlink")=0
   
   If Passed=-1 then
   rs("isAccept")=0
   else
   rs("isAccept")=1
   end if
   If OnTop=-1 then
   rs("IsTop")=1
   else
   rs("IsTop")=0
   End if
   If Hot=-1 then
   'rs("IsHot")=1
   else
   'rs("IsHot")=0
   End if
   rs("addtime")=addtime
   rs("publishtime")="2012-02-13"
   rs("UserID")=0

   rs("TemplateUrl") = fycms.ACT_L(ClassID,5) 
   rs.update
   rs.close
	
	Dim ida,ids
	Set rs=fycms.actexe("Select top 1 id,classid,FileName,addtime from "&fycms.ACT_C(ModeID,2)&"  order by id desc")
	If Not rs.eof Then IDa = rs("ID")
	If Instr(strFileName,"{id}") > 0 Then 
		strFileName = Replace(rs("FileName"),"{id}",rs("id"))
		ids=rs("id"):addtime=rs("addtime")
		fycms.actexe("Update "&fycms.ACT_C(ModeID,2)&" set FileName='"&strFileName&"' where id="&IDa)
	End If 


		If fycms.ACT_C(modeid,18)="1" Then 

 			Call fycms.CreateFolder(fycms.ActSys&"data/"&ModeID&"/")
			Call noSaveFile("by www.fycms.com",fycms.ActSys&"data/"&ModeID&"/index.html")
			Call noSaveFile(Content,fycms.ActSys&"data/"&ModeID&"/"&md5(addtime&ids,32)&".txt")

		End If 
   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_Tbody=True Then
      Content=ScriptHtml(Content,"tbody",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()%>
<!doctype html>
<html>
<head>
<title>采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="../../css/base.css">
<link rel="stylesheet" type="text/css" href="../../css/content.css">
 </head>
<body>
<%End Sub%>

<%
Sub TopItem2 
		Dim ChannelID
		Response.Write "<br>"
		Response.Write "<table width=""800"" align=center  border=""0"" style=""text=align:center"" cellpadding=""0"" cellspacing=""1""  class=table>"
		Response.Write "  <tr >"
		 Response.Write "   <td width=""50%;"" align=""center"" class=""bg_tr""  height=""22"" ><span style=""color:red;""><strong><font id=""CollectEndArea"">系统正在采集</font></strong></span><img src=""../../Images/loading.gif"" border=""0""></td>"
 		Response.Write "  </tr>"
		 Response.Write "   <tr>"
		 Response.Write "     <td height=""45"" colspan=""2"" aling=""center"">本次运行：" & 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> 篇。"
	
 		 Response.Write "     </td>"
		 Response.Write "   </tr>"
		
		
				 Response.Write "   <tr><td height=""45"" colspan=""2"" aling=""center"">"
 		
			  
 	
		 Response.Write "     <br>采集统计：成功采集--" & NewsSuccesNum & "  条数据，失败--" & NewsFalseNum & "  条数据，图片--" & ImagesNumAll & "　张。<a href=""Collect_Main.asp?ChannelID=" & ChannelID &""">停止采集</a>"
		 Response.Write "     </td>"
		 Response.Write "   </tr>"
		
		
		Response.Write "</table>"
		 
		
		    Response.Write "<div id='tips'>"
			Response.Write "<br><br><br><table id=""BarShowArea"" width=""400"" border=""0"" align=""center"" cellspacing=""1"" cellpadding=""1"">"
			Response.Write "<tr> "
			Response.Write "<td bgcolor=000000>"
				Echo " <table width=""600""  height=25 border=""0"" cellspacing=""0"" cellpadding=""1""  class=table>"
			Response.Write "<tr> "
			Echo "<td bgcolor=ffffff height=30><img src=""../../images/bar9.gif"" width=0 height=25 id=img2 name=img2 align=absmiddle></td></tr></table>"
			Response.Write "</td></tr></table>"
				Echo "<table width=""890"" border=""0"" align=""center"" cellspacing=""1"" cellpadding=""1""><tr> "
				Echo "<td align=center> <span id=txt2 name=txt2 style=""font-size:9pt"">0</span><span id=txt4 style=""font-size:9pt"">%</span></td></tr> "
			Response.Write "<tr><td align=center><span id=txt3 name=txt3 style=""font-size:9pt"">0</span></td></tr>"
			Response.Write "</table>"
			Response.Write "<table align=""center"" style=""width:80%""  border=""0"" cellpadding=""0"" cellspacing=""0"">"
			Response.Write " <tr>"
			Response.Write "   <td height=""100"" id=""fsohtml""  align=""center"">系统正在初始化数据...<img src=""../../Images/loading.gif"" border=""0""></td>"
			Response.Write "   </tr>"
			Response.Write "</table>"
			Response.Write "</div>"



 StartTime=Timer()
 End Sub 
'==================================================
'过程名：FootItem2
'作  用：显示该列表采集时间等信息
'参  数：无
'==================================================
Sub FootItem2()
 	   OverTime = Timer()
		   With Response
		        If CollecTest = False Then
				.Write "<meta http-equiv=""refresh"" content=""3;url=collectfun.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum + 1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & """>"
				End If
				if founderr<>true then
					.Write "<script>"
					If CollecTest = False Then
					.Write "fsohtml.innerHTML='执行时间：" & CStr(FormatNumber((OverTime - StartTime) * 1000, 2)) & " 毫秒,数据整理中，3秒后继续......3秒后如果还没反应请点击 <a href=""collectfun.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum + 1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & """><font color=red>这里</font></a> 继续<br>';" & vbCrLf
					else
					.Write "fsohtml.innerHTML='执行时间：" & CStr(FormatNumber((OverTime - StartTime) * 1000, 2)) & " 毫秒';" & vbCrLf
					end if
					.Write "img2.width=400;" & vbCrLf
					.Write "txt2.innerHTML=""采集进度:100"";" & vbCrLf
					.Write "txt3.innerHTML="""";" & vbCrLf
					.Write "img2.title='';</script>" & vbCrLf
				end if
				.Flush
		  End With
End Sub

'==================================================
'过程名：ShowMsg
'作  用：显示信息
'参  数：无
'==================================================
Sub ShowMsg(Msg)
	   Dim strTemp
		   if founderr<>true then
		   strTemp = "<script>document.getElementById('tips').style.display='none';</script>"
		   end if
		   strtemp = strTemp & "<table width=""90%"" border=""0"" bgcolor=""#efefef"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
		   strTemp = strTemp & "   <tr>"
		   strTemp = strTemp & "      <td height=""22"" colspan=""2"" bgcolor=""#ffffff"" 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
%>