BVB Source Codes

Jie Yang v0.6.3 article system Show Admin_ItemCollecFast.asp Source code

Return Download Jie Yang v0.6.3 article system: download Admin_ItemCollecFast.asp Source code - Download Jie Yang v0.6.3 article system Source code - Type:.asp
  1. <!--#include file="inc/conn.asp"-->
  2. <!--#include file="inc/function.asp"-->
  3. <!--#include file="inc/ubbcode.asp"-->
  4. <!--#include file="inc/clsCache.asp"-->
  5. <!--#include file="../admin_check.asp"-->
  6. <link rel="stylesheet" type="text/css" href="../style/Style.css">
  7. <%
  8. Dim ItemNum,ListNum,PaingNum,newsSuccesNum,newsFalseNum
  9. Dim RsItem,SqlItem,ItemEnd,ListEnd,ErrMsg
  10.  
  11. '项目变量
  12. Dim ItemID,ItemName,ChannelID,strChannelDir,ClassID,SpecialID,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
  13. Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr
  14. Dim TsString,ToString,CsString,CoString,DateType,DsString,DoString,AuthorType,AsString,AoString,AuthorStr,CopyFromType,FsString,FoString
  15. Dim CopyFromStr,KeyType,KsString,KoString,KeyStr,newsPaingType,NPsString,NpoString,newsPaingStr,newsPaingHtml
  16. Dim ItemCollecDate,PaginationType,MaxCharPerPage,ReadLevel,Stars,ReadPoint,Hits,UpDateType,UpDateTime,IncludePicYn,DefaultPicYn,OnTop,Elite,Hot
  17. 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,ShowCommentLink,Script_Table,Script_Tr,Script_Td
  18.  
  19. '过滤变量
  20. Dim Arr_Filters,FilterStr,Filteri
  21.  
  22. '采集相关的变量
  23. Dim ContentTemp,newsPaingNext,newsPaingNextCode,Arr_i,newsUrl,newsCode
  24.  
  25. '信息保存变量
  26. Dim ArticleID,newsID,Title,Content,Author,CopyFrom,Key,IncludePic,UploadFiles,DefaultPicUrl
  27.  
  28. '其它变量
  29. Dim LoginData,LoginResult,OrderTemp
  30. Dim Arr_Item,CollecTest,Content_View,CollecnewsAll
  31. Dim StepID
  32.  
  33. '历史记录
  34. Dim Arr_Histrolys,His_Title,His_CollecDate,His_Result,His_Repeat,His_i
  35.  
  36. '执行时间变量
  37. Dim StartTime,OverTime
  38.  
  39. '图片统计
  40. Dim Arr_Images,ImagesNum,ImagesNumAll
  41.  
  42. '列表
  43. Dim ListUrl,ListCode,newsArrayCode,newsArray,ListArray,ListPaingNext
  44.  
  45. '安装路径
  46. Dim strInstallDir,CacheTemp
  47. strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
  48. strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
  49. '缓存路径
  50. CacheTemp=Lcase(trim(request.ServerVariables("SCRIPT_NAME")))
  51. CacheTemp=left(CacheTemp,instrrev(CacheTemp,"/"))
  52. CacheTemp=replace(CacheTemp,"\","_")
  53. CacheTemp=replace(CacheTemp,"/","_")
  54. CacheTemp="ansir" & CacheTemp
  55.  
  56. '数据初始化
  57. CollecListNum=0
  58. CollecnewsNum=0
  59. ItemNum=Clng(Trim(Request("ItemNum")))
  60. ListNum=Clng(Trim(Request("ListNum")))
  61. newsSuccesNum=Clng(Trim(Request("newsSuccesNum")))
  62. newsFalseNum=Clng(Trim(Request("newsFalseNum")))
  63. ImagesNumAll=Clng(Trim(Request("ImagesNumAll")))
  64. ListPaingNext=Trim(Request("ListPaingNext"))
  65. FoundErr=False
  66. ItemEnd=False
  67. ListEnd=False
  68. ErrMsg=""
  69.  
  70. Call SetCache
  71.  
  72. If ItemEnd<>True Then
  73.    If (ItemNum-1)>Ubound(Arr_Item,2) then
  74.       ItemEnd=True
  75.    Else
  76.       Call SetItems()
  77.    End If
  78. End If
  79.  
  80. If ItemEnd<>True Then
  81.    If ListPaingType=0 Then
  82.       If ListNum=1 Then
  83.          ListUrl=ListStr
  84.       Else
  85.          ListEnd=True
  86.       End If
  87.    ElseIf ListPaingType=1 Then
  88.       If ListNum=1 Then
  89.          ListUrl=ListStr
  90.       Else
  91.          If ListPaingNext="" or ListPaingNext="$False$" Then
  92.             ListEnd=True
  93.          Else
  94.             ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
  95.             ListUrl=ListPaingNext
  96.          End If
  97.       End If
  98.    ElseIf ListPaingType=2 Then
  99.       If ListPaingID1>ListPaingID2 then
  100.          If (ListPaingID1-ListNum+1)<ListPaingID2 or (ListPaingID1-ListNum+1)<0 Then
  101.             Listend=True
  102.          Else
  103.             ListUrl=Replace(ListPaingStr2,"{$ID}",Cstr(ListpaingID1-ListNum+1))
  104.          End if
  105.       Else
  106.          If (ListPaingID1+ListNum-1)>ListPaingID2 Then
  107.             ListEnd=True
  108.          Else
  109.             ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
  110.          End If
  111.       End If      
  112.    ElseIf ListPaingType=3  Then
  113.       ListArray=Split(ListPaingStr3,"|")
  114.       If (ListNum-1)>Ubound(ListArray) Then
  115.          ListEnd=True
  116.       Else
  117.          ListUrl=ListArray(ListNum-1)
  118.       End If    
  119.    End If
  120.    If ListNum>CollecListNum And CollecListNum<>0 Then
  121.       ListEnd=True
  122.    End if
  123. End If
  124.  
  125. If ItemEnd=True Then
  126.    ErrMsg="<br>采集任务全部完成"
  127.    ErrMsg=ErrMsg & "<br><br>成功采集: "  &  newsSuccesNum  &  "  条,失败: "    &  newsFalseNum  &  "  条,图片:" & ImagesNumAll & "  张"
  128.    Call DelCache()
  129. Else
  130.    If ListEnd=True Then
  131.       ItemNum=ItemNum+1
  132.       ListNum=1
  133.       ErrMsg="<br>" & ItemName & "  项目所有列表采集完成,正在整理数据请稍后..."
  134.       ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&newsSuccesNum=" & newsSuccesNum & "&newsFalseNum=" & newsFalseNum & "&ImagesNumAll=" & ImagesNumAll & """>"
  135.    End If
  136. End If
  137.  
  138. Call TopItem()
  139. If ItemEnd=True Or ListEnd=True Then
  140.    If ItemEnd<>True Then
  141.       Call SetCache_His()
  142.    End If
  143.    Call WriteSucced(ErrMsg)
  144. Else
  145.    FoundErr=False
  146.    ErrMsg=""
  147.    Call StartCollection()
  148.    Call FootItem2()
  149. End  If
  150. Call FootItem()
  151. Response.Flush()
  152. '关闭数据库链接
  153. %>
  154.  
  155. <%
  156. '==================================================
  157. '过程名:StartCollection
  158. '作  用:开始采集
  159. '参  数:无
  160. '==================================================
  161. Sub StartCollection
  162.  
  163. '第一次采集时登录
  164. If LoginType=1 And ListNum=1 then
  165.    LoginData=UrlEncoding(LoginUser & "&" & LoginPass)
  166.    LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData)
  167.    If Instr(LoginResult,LoginFalse)>0 Then
  168.       FoundErr=True
  169.       ErrMsg=ErrMsg & "<br><br><li>在登录网站时发生错误,请确保登录信息的正确性!</li>"
  170.    End If
  171. End If
  172.  
  173. If FoundErr<>True then
  174.    ListCode=GetHttpPage(ListUrl)
  175.    Call GetListPaing()
  176.    If ListCode="$False$" Then
  177.       FoundErr=True
  178.       ErrMsg=ErrMsg & "<br><br><li>在获取列表:" & ListUrl & "网页源码时发生错误!</li>"
  179.    Else
  180.       ListCode=GetBody(ListCode,LsString,LoString,False,False)
  181.       If ListCode="$False$" Or ListCode="" Then
  182.          FoundErr=True
  183.          ErrMsg=ErrMsg & "<br><br><li>在截取:" & ListUrl & "的信息列表时发生错误!</li>"
  184.       End If
  185.    End If
  186. End If
  187.  
  188. If FoundErr<>True Then
  189.    newsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
  190.    If newsArrayCode="$False$" Then
  191.       FoundErr=True
  192.       ErrMsg=ErrMsg & "<br><br><li>在分析:" & ListUrl & "信息列表时发生错误!</li>"
  193.    Else
  194.       newsArray=Split(newsArrayCode,"$Array$")
  195.       For Arr_i=0 to Ubound(newsArray)
  196.          If HttpUrlType=1 Then
  197.             newsArray(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",newsArray(Arr_i)))
  198.          Else
  199.             newsArray(Arr_i)=Trim(DefiniteUrl(newsArray(Arr_i),ListUrl))          
  200.          End If
  201.          newsArray(Arr_i)=CheckUrl(newsArray(Arr_i))
  202.       Next
  203.       If CollecOrder=True Then
  204.          For Arr_i=0 to Fix(Ubound(newsArray)/2)
  205.             OrderTemp=newsArray(Arr_i)
  206.             newsArray(Arr_i)=newsArray(Ubound(newsArray)-Arr_i)
  207.             newsArray(Ubound(newsArray)-Arr_i)=OrderTemp
  208.          Next
  209.       End If
  210.    End If
  211. End If
  212.  
  213. If FoundErr<>True Then
  214.    Call TopItem2()
  215.    CollecnewsAll=0
  216.    For Arr_i=0 to Ubound(newsArray)
  217.       If CollecnewsAll>=CollecnewsNum And CollecnewsNum<>0 Then
  218.          Exit For
  219.       End If
  220.       CollecnewsAll=CollecnewsAll+1
  221.       '变量初始化
  222.       UploadFiles=""
  223.       DefaultPicUrl=""
  224.       IncludePic=0
  225.       ImagesNum=0
  226.       newsCode=""
  227.       FoundErr=False
  228.       ErrMsg=""
  229.       His_Repeat=False
  230.       newsUrl=newsArray(Arr_i)
  231.       Title=""
  232.       PaingNum=1
  233.       '………………………………………………
  234.       If Response.IsClientConnected Then
  235.          Response.Flush
  236.       Else
  237.          Response.End
  238.       End If
  239.       '………………………………………………
  240.  
  241.       If CollecTest=False Then
  242.          His_Repeat=CheckRepeat(newsUrl)
  243.       Else
  244.          His_Repeat=False
  245.       End If
  246.       If His_Repeat=True Then
  247.          FoundErr=True
  248.       End If
  249.  
  250.       If FoundErr<>True Then
  251.          newsCode=GetHttpPage(newsUrl)
  252.          If newsCode="$False$" Then
  253.             FoundErr=True
  254.             ErrMsg=ErrMsg & "<br><br>在获取:" & newsUrl & "信息源码时发生错误!"
  255.             Title="获取网页源码失败"
  256.          End If
  257.       End If
  258.  
  259.       If FoundErr<>True Then
  260.          Title=GetBody(newsCode,TsString,ToString,False,False)
  261.          If Title="$False$" or Title="" then
  262.             FoundErr=True
  263.             ErrMsg=ErrMsg & "<br><br>在分析:" & newsUrl & "的信息标题时发生错误"
  264.             Title="<br><br>标题分析错误"
  265.          End If
  266.          If FoundErr<>True Then
  267.             Content=GetBody(newsCode,CsString,CoString,False,False)
  268.             If Content="$False$" or Content="" Then
  269.                FoundErr=True
  270.                ErrMsg=ErrMsg & "<br><br>在分析:" & newsUrl & "的信息正文时发生错误"
  271.                Title=Title & "<br><br>正文分析错误"
  272.             End If
  273.          End If
  274.          If FoundErr<>True Then
  275.             '信息分页
  276.             If newsPaingType=1 Then
  277.                newsPaingNext=GetPaing(newsCode,NPsString,NPoString,False,False)
  278.                newsPaingNext=FpHtmlEnCode(newsPaingNext)
  279.                Do While newsPaingNext<>"$False$" And newsPaingNext<>""
  280.                   If newsPaingStr="" or IsNull(newsPaingStr)=True Then
  281.                      newsPaingNext=DefiniteUrl(newsPaingNext,newsUrl)
  282.                   Else
  283.                      newsPaingNext=Replace(newsPaingStr,"{$ID}",newsPaingNext)
  284.                   End If
  285.                   If newsPaingNext="" or newsPaingNext="$False$" Then
  286.                      Exit Do
  287.                   End If
  288.                   newsPaingNextCode=GetHttpPage(newsPaingNext)                  
  289.                   ContentTemp=GetBody(newsPaingNextCode,CsString,CoString,False,False)
  290.                   If ContentTemp="$False$" Then
  291.                      Exit Do
  292.                   Else
  293.                      PaingNum=PaingNum+1
  294.                      Content=Content & newsPaingHtml & ContentTemp
  295.                      newsPaingNext=GetPaing(newsPaingNextCode,NPsString,NPoString,False,False)
  296.                      newsPaingNext=FpHtmlEnCode(newsPaingNext)
  297.                   End If
  298.                Loop
  299.             End If
  300.             '过滤
  301.             Call Filters
  302.             Title=FpHtmlEnCode(Title)
  303.             Call FilterScript()
  304.             Content=Ubbcode(Content)
  305.          End If
  306.       End If
  307.  
  308.       '分开写(太长了照顾不过来)
  309.       If FoundErr<>True Then
  310.          '时间
  311.          If UpDateType=0 Then
  312.             UpDateTime=Now()
  313.          ElseIf UpDateType=1 Then
  314.             If DateType=0 then
  315.                UpDateTime=Now()
  316.             Else
  317.                UpDateTime=GetBody(newsCode,DsString,DoString,False,False)
  318.                UpDateTime=FpHtmlEncode(UpDateTime)
  319.                UpDateTime=Trim(Replace(UpDateTime,"&nbsp;"," "))
  320.                If IsDate(UpDateTime)=True Then
  321.                   UpDateTime=CDate(UpDateTime)
  322.                Else
  323.                   UpDateTime=Now()
  324.                End If
  325.             End If
  326.          ElseIf UpDateType=2 Then  
  327.          Else
  328.             UpDateTime=Now()
  329.          End If
  330.                  
  331.          '作者
  332.          If AuthorType=1 Then
  333.             Author=GetBody(newsCode,AsString,AoString,False,False)
  334.          ElseIf AuthorType=2 Then
  335.             Author=AuthorStr
  336.          Else
  337.             Author="佚名"
  338.          End If
  339.          Author=FpHtmlEncode(Author)
  340.          If Author="" or Author="$False$" then
  341.             Author="佚名"
  342.          Else
  343.             If Len(Author)>255 then
  344.                Author=Left(Author,255)
  345.             End If
  346.          End If
  347.            
  348.          '来源
  349.          If CopyFromType=1 Then
  350.             CopyFrom=GetBody(newsCode,FsString,FoString,False,False)
  351.          ElseIf CopyFromType=2 Then
  352.             CopyFrom=CopyFromStr
  353.          Else
  354.             CopyFrom="不详"
  355.          End If
  356.          CopyFrom=FpHtmlEncode(CopyFrom)
  357.          If CopyFrom="" or CopyFrom="$False$" Then
  358.                     CopyFrom="不详"
  359.          Else
  360.             If Len(CopyFrom)>255 Then
  361.                CopyFrom=Left(CopyFrom,255)
  362.             End If
  363.          End If
  364.  
  365.          '关键字
  366.          If KeyType=0 Then
  367.             Key=Title
  368.             Key=CreateKeyWord(Key,2)
  369.          ElseIf KeyType=1 Then
  370.             Key=GetBody(newsCode,KsString,KoString,False,False)
  371.             Key=FpHtmlEncode(Key)
  372.             Key=CreateKeyWord(Key,2)
  373.          ElseIf KeyType=2 Then
  374.             Key=KeyStr
  375.             Key=FpHtmlEncode(Key)
  376.             If Len(Key)>253 Then
  377.                Key="|" & Left(Key,253) & "|"
  378.             Else
  379.                Key="|" & Key & "|"
  380.             End If
  381.          End If
  382.          If Key="" or Key="$False$" Then
  383.             Key="|信息|"
  384.          End If
  385.          '转换图片相对地址为绝对地址/保存
  386.  
  387.          If CollecTest=False And SaveFiles=True then
  388.             Content=ReplaceSaveRemoteFile(Content,strInstallDir,True,newsUrl)              
  389.          Else
  390.             Content=ReplaceSaveRemoteFile(Content,strInstallDir,False,newsUrl)
  391.          End If
  392.  
  393.          '转换swf文件地址
  394.          Content=ReplaceSwfFile(Content,newsUrl)
  395.  
  396.          '图片统计、信息图片属性设置
  397.          If UploadFiles<>"" Then
  398.             If Instr(UploadFiles,"|")>0 Then
  399.                Arr_Images=Split(UploadFiles,"|")
  400.                ImagesNum=Ubound(Arr_Images)+1
  401.                DefaultPicUrl=Arr_Images(0)
  402.             Else
  403.                ImagesNum=1
  404.                DefaultPicUrl=UploadFiles
  405.             End If
  406.  
  407.             If DefaultPicYn=False then
  408.                DefaultPicUrl=""
  409.             End If
  410.             If IncludePicYn=True Then
  411.                IncludePic=-1
  412.             Else
  413.                IncludePic=0
  414.             End If
  415.             If SaveFiles<>True Then
  416.                UploadFiles=""
  417.             End If
  418.          Else
  419.             ImagesNum=0
  420.             DefaultPicUrl=""
  421.             IncludePic=0        
  422.          End If
  423.          ImagesNumAll=ImagesNumAll+ImagesNum
  424.       End If
  425.  
  426.       If FoundErr<>True Then
  427.          If CollecTest=False Then
  428.             Call SaveArticle
  429.                         SqlItem="select ItemID,ClassID,Title,CollecDate,newsUrl,Result from Histroly where Title='"&Title&"'"
  430.                         Set rsItem=Server.CreateObject("ADODB.RecordSet")
  431.                         rsItem.open sqlItem,ConnItem,1,3
  432.                         if RsItem.eof then
  433.                                 RsItem.addnew
  434.                                         RsItem("ItemID")=ItemID
  435.                                         RsItem("ClassID")=ClassID
  436.                                         RsItem("Title")=Title
  437.                                         RsItem("CollecDate")=Now()
  438.                                         RsItem("newsUrl")=newsUrl
  439.                                         RsItem("Result")=True
  440.                                 RsItem.update
  441.                         end if
  442.                         RsItem.close
  443.                         Set RsItem=nothing                     
  444.             Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & strChannelDir & "/")
  445.          End If
  446.          newsSuccesNum=newsSuccesNum+1
  447.          ErrMsg=ErrMsg & "No:<font color=red>" & newsSuccesNum+newsFalseNum & "</font><br>"
  448.          ErrMsg=ErrMsg & "信息标题:"
  449.          ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
  450.          ErrMsg=ErrMsg & "更新时间:" & UpDateTime & "<br>"
  451.          ErrMsg=ErrMsg & "信息作者:" & Author & "<br>"
  452.          ErrMsg=ErrMsg & "信息来源:" & CopyFrom & "<br>"
  453.          ErrMsg=ErrMsg & "采集页面:<a href=" & newsUrl & " target=_blank>" & newsUrl & "</a><br>"
  454.          ErrMsg=ErrMsg & "其它信息:分页--" & PaingNum & " 页,图片--" & ImagesNum & " 张<br>"
  455.          ErrMsg=ErrMsg & "正文预览:"
  456.          If Content_View=True Then
  457.             ErrMsg=ErrMsg & "<br>" & Content
  458.          Else
  459.             ErrMsg=ErrMsg & "您没有启用正文预览功能"
  460.          End If
  461.          ErrMsg=ErrMsg & "<br><br>关 键 字:" & Key & ""
  462.       Else
  463.          newsFalseNum=newsFalseNum+1
  464.          If His_Repeat=True Then
  465.             ErrMsg=ErrMsg & "No:<font color=red>" & newsSuccesNum+newsFalseNum & "</font><br>"
  466.             ErrMsg=ErrMsg & "目标信息:<font color=red>"
  467.             If His_Result=True Then
  468.                ErrMsg=ErrMsg & His_Title
  469.             Else
  470.                ErrMsg=ErrMsg & newsUrl
  471.             End If
  472.             ErrMsg=ErrMsg & "</font> 的记录已存在,不给予采集。<br>"
  473.             ErrMsg=ErrMsg & "采集时间:" & His_CollecDate & "<br>"
  474.             ErrMsg=ErrMsg & "信息来源:<a href='" & newsUrl & "' target=_blank>"&newsUrl&"</a><br>"
  475.             ErrMsg=ErrMsg & "采集结果:"
  476.             If His_Result=False Then
  477.                ErrMsg=ErrMsg & "失败"
  478.                ErrMsg=ErrMsg & "<br>失败原因:" & Title
  479.             Else
  480.                ErrMsg=ErrMsg & "成功"
  481.             End If            
  482.             ErrMsg=ErrMsg & "<br>提示信息:如想再次采集,请先将该信息的历史记录<font color=red>删除</font><br>"
  483.          End If
  484.          If CollecTest=False And His_Repeat=False Then
  485.             SqlItem="INSERT INTO Histroly(ItemID,ClassID,Title,CollecDate,newsUrl,Result) VALUES ('" & ItemID & "','" & ClassID & "','" & Title & "','" & Now() & "','" & newsUrl & "',False)"
  486.             ConnItem.Execute(SqlItem)
  487.          End If
  488.       End If
  489.       Call ShowMsg(ErrMsg)
  490.       Response.Flush()'刷新
  491.    Next
  492. Else
  493.    Call ShowMsg(ErrMsg)
  494. End If
  495.  
  496. Response.Write "<table width=""98%"" align=""center"" border=""0"" cellpadding=""2"" cellspacing=""1"" class=""mtab"" bgcolor=""#8ED1FF"">"
  497. Response.Write "<tr><td bgcolor='#ffffff'>"
  498. If CollecTest=False Then
  499.    Response.Write "数据整理中,5秒后继续......5秒后如果还没反应请点击 <a href='Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&newsSuccesNum=" & newsSuccesNum & "&newsFalseNum=" & newsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>这里</font></a> 继续<br>"
  500.    Response.Write "<meta http-equiv=""refresh"" content=""5;url=Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&newsSuccesNum=" & newsSuccesNum & "&newsFalseNum=" & newsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext  & """>"
  501. Else
  502.    Response.Write "<a href='Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&newsSuccesNum=" & newsSuccesNum & "&newsFalseNum=" & newsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>请 继 续</font></a>"
  503. End If
  504. Response.Write "</td></tr>"
  505. Response.Write "</table>"
  506. End Sub
  507.  
  508.  
  509.  
  510. '==================================================
  511. '过程名:SetCache
  512. '作  用:存取缓存
  513. '参  数:无
  514. '==================================================
  515. Sub SetCache()
  516.    Dim myCache
  517.    Set myCache=new clsCache
  518.  
  519.    '项目信息
  520.    myCache.name=CacheTemp & "items"
  521.    If myCache.valid then
  522.       Arr_Item=myCache.value
  523.    Else
  524.       ItemEnd=True
  525.    End If
  526.  
  527.    '过滤信息
  528.    myCache.name=CacheTemp & "filters"
  529.    If myCache.valid then
  530.       Arr_Filters=myCache.value
  531.    End If
  532.  
  533.    '历史记录
  534.    myCache.name=CacheTemp & "histrolys"
  535.    If myCache.valid then
  536.       Arr_Histrolys=myCache.value
  537.    End If
  538.  
  539.    '其它信息
  540.    myCache.name=CacheTemp & "collectest"
  541.    If myCache.valid then
  542.       CollecTest=myCache.value
  543.    Else
  544.       CollecTest=False
  545.    End If
  546.    myCache.name=CacheTemp & "contentview"
  547.    If myCache.valid then
  548.       Content_View=myCache.value
  549.    Else
  550.       Content_View=False
  551.    End If
  552.  
  553.    Set myCache=Nothing
  554. End Sub
  555.  
  556. Sub DelCache()
  557.    Dim myCache
  558.    Set myCache=new clsCache
  559.    myCache.name=CacheTemp & "items"
  560.    Call myCache.clean()
  561.    myCache.name=CacheTemp & "filters"
  562.    Call myCache.clean()
  563.    myCache.name=CacheTemp & "histrolys"
  564.    Call myCache.clean()
  565.    myCache.name=CacheTemp & "collectest"
  566.    Call myCache.clean()
  567.    myCache.name=CacheTemp & "contentview"
  568.    Call myCache.clean()
  569.    Set myCache=Nothing
  570. End Sub
  571.  
  572. '==================================================
  573. '过程名:SetItems
  574. '作  用:获取项目信息
  575. '参  数:无
  576. '==================================================
  577. Sub SetItems()
  578.       Dim ItemNumTemp
  579.       ItemNumTemp=ItemNum-1
  580.       ItemID=Arr_Item(0,ItemNumTemp)
  581.       ItemName=Arr_Item(1,ItemNumTemp)
  582.           ChannelID=Arr_Item(2,ItemNumTemp)  '栏目
  583.       ClassID=Arr_Item(3,ItemNumTemp)  '栏目
  584.          
  585.           LoginType=Arr_Item(7,ItemNumTemp)
  586.       LoginUrl=Arr_Item(8,ItemNumTemp)          '登录
  587.       LoginPostUrl=Arr_Item(9,ItemNumTemp)
  588.       LoginUser=Arr_Item(10,ItemNumTemp)
  589.       LoginPass=Arr_Item(11,ItemNumTemp)
  590.       LoginFalse=Arr_Item(12,ItemNumTemp)
  591.       ListStr=Arr_Item(13,ItemNumTemp)            '列表地址
  592.       LsString=Arr_Item(14,ItemNumTemp)          '列表
  593.       LoString=Arr_Item(15,ItemNumTemp)
  594.       ListPaingType=Arr_Item(16,ItemNumTemp)
  595.       LPsString=Arr_Item(17,ItemNumTemp)          
  596.       LPoString=Arr_Item(18,ItemNumTemp)
  597.       ListPaingStr1=Arr_Item(19,ItemNumTemp)
  598.       ListPaingStr2=Arr_Item(20,ItemNumTemp)
  599.       ListPaingID1=Arr_Item(21,ItemNumTemp)
  600.       ListPaingID2=Arr_Item(22,ItemNumTemp)
  601.       ListPaingStr3=Arr_Item(23,ItemNumTemp)
  602.       HsString=Arr_Item(24,ItemNumTemp)  
  603.       HoString=Arr_Item(25,ItemNumTemp)
  604.       HttpUrlType=Arr_Item(26,ItemNumTemp)
  605.       HttpUrlStr=Arr_Item(27,ItemNumTemp)
  606.       TsString=Arr_Item(28,ItemNumTemp)          '标题
  607.       ToString=Arr_Item(29,ItemNumTemp)
  608.       CsString=Arr_Item(30,ItemNumTemp)          '正文
  609.       CoString=Arr_Item(31,ItemNumTemp)
  610.       DateType=Arr_Item(32,ItemNumTemp)      '作者
  611.           DsString=Arr_Item(33,ItemNumTemp)          
  612.       DoString=Arr_Item(34,ItemNumTemp)
  613.      
  614.           AuthorType=Arr_Item(35,ItemNumTemp)      '作者
  615.       AsString=Arr_Item(36,ItemNumTemp)          
  616.       AoString=Arr_Item(37,ItemNumTemp)
  617.       AuthorStr=Arr_Item(38,ItemNumTemp)
  618.       CopyFromType=Arr_Item(39,ItemNumTemp)  '来源
  619.       FsString=Arr_Item(40,ItemNumTemp)          
  620.       FoString=Arr_Item(41,ItemNumTemp)
  621.       CopyFromStr=Arr_Item(42,ItemNumTemp)
  622.           KeyType=Arr_Item(43,ItemNumTemp)            '关键词
  623.       KsString=Arr_Item(44,ItemNumTemp)          
  624.       KoString=Arr_Item(45,ItemNumTemp)  
  625.           KeyStr=Arr_Item(46,ItemNumTemp)
  626.           newsPaingType=Arr_Item(47,ItemNumTemp)
  627.       NPsString=Arr_Item(48,ItemNumTemp)          
  628.       NPoString=Arr_Item(49,ItemNumTemp)
  629.          
  630.       newsPaingStr=Arr_Item(50,ItemNumTemp)
  631.       newsPaingHtml=Arr_Item(51,ItemNumTemp)
  632.          
  633.       PaginationType=Arr_Item(53,ItemNumTemp)
  634.       MaxCharPerPage=Arr_Item(54,ItemNumTemp)
  635.       ReadLevel=Arr_Item(55,ItemNumTemp)
  636.       Stars=Arr_Item(56,ItemNumTemp)
  637.       ReadPoint=Arr_Item(57,ItemNumTemp)
  638.       Hits=Arr_Item(58,ItemNumTemp)
  639.       UpDateType=Arr_Item(59,ItemNumTemp)
  640.       UpDateTime=Arr_Item(60,ItemNumTemp)
  641.       IncludePicYn=Arr_Item(61,ItemNumTemp)
  642.       DefaultPicYn=Arr_Item(62,ItemNumTemp)
  643.       OnTop=Arr_Item(63,ItemNumTemp)
  644.       Elite=Arr_Item(64,ItemNumTemp)
  645.       Hot=Arr_Item(65,ItemNumTemp)
  646.       SkinID=Arr_Item(66,ItemNumTemp)
  647.       TemplateID=Arr_Item(67,ItemNumTemp)
  648.       Script_Iframe=Arr_Item(68,ItemNumTemp)
  649.       Script_Object=Arr_Item(69,ItemNumTemp)
  650.       Script_Script=Arr_Item(70,ItemNumTemp)
  651.       Script_Div=Arr_Item(71,ItemNumTemp)
  652.       Script_Class=Arr_Item(72,ItemNumTemp)
  653.       Script_Span=Arr_Item(73,ItemNumTemp)
  654.       Script_Img=Arr_Item(74,ItemNumTemp)
  655.       Script_Font=Arr_Item(75,ItemNumTemp)
  656.       Script_A=Arr_Item(76,ItemNumTemp)
  657.       Script_Html=Arr_Item(77,ItemNumTemp)
  658.       CollecListNum=Arr_Item(78,ItemNumTemp)
  659.       CollecnewsNum=Arr_Item(79,ItemNumTemp)
  660.          
  661.       Passed=Arr_Item(80,ItemNumTemp)
  662.       SaveFiles=Arr_Item(81,ItemNumTemp)
  663.       CollecOrder=Arr_Item(82,ItemNumTemp)
  664.       LinkUrlYn=Arr_Item(83,ItemNumTemp)
  665.       InputerType=Arr_Item(84,ItemNumTemp)
  666.       Inputer=Arr_Item(85,ItemNumTemp)
  667.       EditorType=Arr_Item(86,ItemNumTemp)
  668.       Editor=Arr_Item(87,ItemNumTemp)
  669.       ShowCommentLink=Arr_Item(88,ItemNumTemp)
  670.       Script_Table=Arr_Item(89,ItemNumTemp)
  671.       Script_Tr=Arr_Item(90,ItemNumTemp)
  672.       Script_Td=Arr_Item(91,ItemNumTemp)
  673.  
  674.       If InputerType=1 Then
  675.          Inputer=FpHtmlEnCode(Inputer)
  676.       Else
  677.          Inputer=session("AdminName")
  678.       End If
  679.       If EditorType=1 Then
  680.          Editor=FpHtmlEnCode(Editor)
  681.       Else
  682.          Editor=session("AdminName")
  683.       End If
  684.       If IsObjInstalled("Scripting.FileSystemObject")=False Then
  685.          SaveFiles=False
  686.       End if
  687. End Sub
  688.  
  689. '==================================================
  690. '过程名:GetListPaing
  691. '作  用:获取列表下一页
  692. '参  数:无
  693. '==================================================
  694. Sub GetListPaing()
  695.    If ListPaingType=1 Then
  696.       ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
  697.       ListPaingNext=FpHtmlEnCode(ListPaingNext)
  698.       If ListPaingNext<>"$False$" And ListPaingNext<>"" Then
  699.          If ListPaingStr1<>""  Then  
  700.             ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
  701.          Else
  702.             ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
  703.          End If
  704.          ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
  705.       End If
  706.    Else
  707.       ListPaingNext="$False$"
  708.    End If
  709. End Sub
  710.  
  711. '==================================================
  712. '过程名:SaveArticle
  713. '作  用:保存信息
  714. '参  数:无
  715. '==================================================
  716. Sub SaveArticle
  717.    set rs=server.createobject("adodb.recordset")
  718.    sql="select N_cid,N_sid,N_Title,N_Content,N_hits,N_from,N_addtime from Article_news where N_Title='"&Title&"'"
  719.    rs.open sql,conn,1,3
  720.    if rs.eof then
  721.            rs.addnew
  722.            rs("N_cid")=ChannelID
  723.            rs("N_sid")=ClassID
  724.            rs("N_Title")=Title
  725.            rs("N_Content")=content
  726.            rs("N_hits")=Hits
  727.            rs("N_from")=sitenames
  728.            rs("N_addtime")=UpDateTime
  729.            rs.update
  730.    end if
  731.    rs.close
  732.    set rs=nothing
  733. End Sub
  734.  
  735.  
  736. '==================================================
  737. '过程名:Filters
  738. '作  用:过滤
  739. '==================================================
  740. Sub Filters()
  741. If IsNull(Arr_Filters)=True or IsArray(Arr_Filters)=False Then
  742.    Exit Sub
  743. End if
  744.  
  745.    For Filteri=0 to Ubound(Arr_Filters,2)
  746.       FilterStr=""
  747.       If Arr_Filters(1,Filteri)=ItemID Or Arr_Filters(10,Filteri)=True Then
  748.          If Arr_Filters(3,Filteri)=1 Then'标题过滤
  749.             If Arr_Filters(4,Filteri)=1 Then
  750.                Title=Replace(Title,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
  751.             ElseIf Arr_Filters(4,Filteri)=2 Then
  752.                FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  753.                Do While FilterStr<>"$False$"
  754.                   Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
  755.                   FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  756.                Loop
  757.             End If
  758.          ElseIf Arr_Filters(3,Filteri)=2 Then'正文过滤
  759.             If Arr_Filters(4,Filteri)=1 Then
  760.                Content=Replace(Content,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
  761.             ElseIf Arr_Filters(4,Filteri)=2 Then
  762.                FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  763.                Do While FilterStr<>"$False$"
  764.                   Content=Replace(Content,FilterStr,Arr_Filters(8,Filteri))
  765.                   FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  766.                Loop
  767.             End If
  768.          End If
  769.       End If
  770.    Next
  771. End Sub
  772.  
  773. '==================================================
  774. '过程名:FilterScript
  775. '作  用:脚本过滤
  776. '==================================================
  777.  
  778. Sub  FilterScript()
  779.    If Script_Iframe=True Then
  780.       Content=ScriptHtml(Content,"Iframe",1)
  781.    End If
  782.    If Script_Object=True Then
  783.       Content=ScriptHtml(Content,"Object",2)
  784.    End If
  785.    If Script_Script=True Then
  786.       Content=ScriptHtml(Content,"Script",2)
  787.    End If
  788.    If Script_Div=True Then
  789.       Content=ScriptHtml(Content,"Div",3)
  790.    End If
  791.    If Script_Table=True Then
  792.       Content=ScriptHtml(Content,"table",3)
  793.    End If
  794.    If Script_Tr=True Then
  795.       Content=ScriptHtml(Content,"tr",3)
  796.    End If
  797.    If Script_Td=True Then
  798.       Content=ScriptHtml(Content,"td",3)
  799.    End If
  800.    If Script_Span=True Then
  801.       Content=ScriptHtml(Content,"Span",3)
  802.    End If
  803.    If Script_Img=True Then
  804.       Content=ScriptHtml(Content,"Img",3)
  805.    End If
  806.    If Script_Font=True Then
  807.       Content=ScriptHtml(Content,"Font",3)
  808.    End If
  809.    If Script_A=True Then
  810.       Content=ScriptHtml(Content,"A",3)
  811.    End If
  812.    If Script_Html=True Then
  813.       Content=noHtml(Content)
  814.    End If
  815. End  Sub
  816.  
  817. '==================================================
  818. '过程名:TopItem
  819. '作  用:显示导航信息
  820. '参  数:无
  821. '==================================================
  822. Sub TopItem()%>
  823. <html>
  824. <head>
  825. <title>信息采集系统</title>
  826. <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
  827. </head>
  828. <body>
  829. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">
  830.   <tr>
  831.     <td class="td28">采集系统采集理管理</td>
  832.   </tr>
  833.   <tr class="td26" bgcolor="#FFFFFF">
  834.     <td><b>管理导航:</b><a href="Admin_ItemStart.asp">管理首页</a> >> 信息采集</td>
  835.   </tr>
  836. </table>
  837. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">    
  838.   <tr>
  839.     <td bgcolor="#FFFFFF" aling="center" style="padding:4px; line-height:30px;">采集需要一定的时间,请耐心等待,如果网站出现暂时无法访问的情况这是正常的,采集正常结束后即可恢复。</td>
  840.   </tr>
  841. </table>
  842. <%End Sub%>
  843. <%
  844. Sub TopItem2%>
  845. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">
  846.     <tr>
  847.       <td bgcolor="#FFFFFF" style="padding:4px; line-height:30px;" colspan="2" 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> 条。
  848.       <%if CollecnewsNum<>0 Then Response.Write "限制 <font color=red>" & CollecnewsNum & "</font> 条。"%>
  849.       <br>采集统计:成功采集--<%=newsSuccesNum%>  条信息,失败--<%=newsFalseNum%>  条,图片--<%=ImagesNumAll%> 张。<a href="Admin_ItemStart.asp">停止采集</a>
  850.       </td>
  851.     </tr>
  852. </table>
  853. <%StartTime=Timer()%>
  854. <%End Sub%>
  855.  
  856. <%
  857. '==================================================
  858. '过程名:FootItem
  859. '作  用:显示底部版权等信息
  860. '参  数:无
  861. '==================================================
  862. Sub FootItem()%>
  863. </body>        
  864. </html>
  865. <%End Sub%>
  866.  
  867. <%
  868. '==================================================
  869. '过程名:FootItem2
  870. '作  用:显示该列表采集时间等信息
  871. '参  数:无
  872. '==================================================
  873. Sub FootItem2()
  874.    Dim strTemp
  875.    OverTime=Timer()
  876.    strTemp= "<table width=""98%"" align=""center"" border=""0"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#8ED1FF"" class=""mtab"">"      
  877.    strTemp=strTemp & "<tr>"          
  878.    strTemp=strTemp & "<td bgcolor='#ffffff'>"
  879.    strTemp=strTemp & "执行时间:" & CStr(FormatNumber((OverTime-StartTime)*1000,2)) & " 毫秒"
  880.    strTemp=strTemp & "</td></tr><br>"
  881.    strTemp=strTemp & "</table>"
  882.    Response.write strTemp
  883. End Sub
  884.  
  885. '==================================================
  886. '过程名:ShowMsg
  887. '作  用:显示信息
  888. '参  数:无
  889. '==================================================
  890. Sub ShowMsg(Msg)
  891.    Dim strTemp
  892.    strTemp= "<table width=""98%"" align=""center"" border=""0"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#8ED1FF"" class=""mtab"">"      
  893.    strTemp=strTemp & "<tr>"          
  894.    strTemp=strTemp & "<td bgcolor='#ffffff' style='padding:4px;'>"
  895.    strTemp=strTemp & Msg
  896.    strTemp=strTemp & "</td>"
  897.    strTemp=strTemp & "</tr>"
  898.    strTemp=strTemp & "</table>"
  899.    Response.Write StrTemp    
  900. End Sub
  901.  
  902. Function CheckRepeat(strUrl)
  903.    CheckRepeat=False
  904.    If IsArray(Arr_Histrolys)=True then
  905.       For His_i=0 to Ubound(Arr_Histrolys,2)
  906.          If Arr_Histrolys(0,His_i)=strUrl Then
  907.             CheckRepeat=True
  908.             His_Title=Arr_Histrolys(1,His_i)
  909.             His_CollecDate=Arr_Histrolys(2,His_i)
  910.             His_Result=Arr_Histrolys(3,His_i)
  911.             Exit For
  912.          End If
  913.       Next
  914.    End If
  915. End Function
  916.  
  917. Sub SetCache_His()
  918.    '历史记录
  919.    SqlItem ="select newsUrl,Title,CollecDate,Result from Histroly"
  920.    Set RsItem=Server.CreateObject("adodb.recordset")
  921.    RsItem.Open SqlItem,ConnItem,1,1
  922.    If Not RsItem.Eof Then
  923.       Arr_Histrolys=RsItem.GetRows()
  924.    End If
  925.    RsItem.Close
  926.    Set RsItem=Nothing
  927.  
  928.    Dim myCache
  929.    Set myCache=new clsCache
  930.    myCache.name=CacheTemp & "histrolys"
  931.    Call myCache.clean()
  932.    If IsArray(Arr_Histrolys)=True Then  
  933.       myCache.add Arr_Histrolys,Dateadd("n",1000,now)
  934.    End If
  935. End Sub
  936. %>
downloadAdmin_ItemCollecFast.asp Source code - Download Jie Yang v0.6.3 article system Source code
Related Source Codes/Software:
Jilin classification information release system v5.0 trial version - A ready-made classifieds site publishing system, h... 2016-09-21
Linyi CMS v6.5 market classification information - A. supply and demand information function: informa... 2016-09-21
Tesco discount net SQL version - And presentations, faster. 2016-09-21
- electronic enterprise website management system In a fully functional version - Super suitable for enterprise agents build a corpo... 2016-09-21
Rio mesh network hard disk system v3.0 - System functions: 1, increase the progress of Asp... 2016-09-21
Classified information network business in suzhou - Overall module: classification of supply and deman... 2016-09-21
NPOINT virtual host v1.7.0 formal version management system - The system main function is introduced 2016-09-21
IDC sales web site - Beautiful IDC sales web site source code 2016-09-21
Oo 126 CMS movie site system - This procedure ASP + ACC/ASP + SQL, using new kern... 2016-09-21
Pcook CMS bubble guest v3.0 SDCMS version - Developed by Asp+Access, and meet the needs of sma... 2016-09-21
CRYENGINE - CRYENGINE is a powerful real-time game development... 2017-06-11
postal - 2017-06-11
reactide - Reactide is the first dedicated IDE for React web ... 2017-06-11
rkt - rkt is a pod-native container engine for Linux. It... 2017-06-11
uWebSockets - Tiny WebSockets https://for... 2017-06-11
realworld - TodoMVC for the RealWorld - Exemplary fullstack Me... 2017-06-11
goreplay - GoReplay is an open-source tool for capturing and ... 2017-06-10
pyenv - Simple Python version management 2017-06-10
redux-saga - An alternative side effect model for Redux apps ... 2017-06-10
angular-starter - 2017-06-10

 Back to top