BVB Source Codes

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

Return Download Jie Yang v0.6.3 article system: download Admin_ItemCollecScreen.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. '传递变量:ItemNum--项目
  9. '          ListNum--列表
  10. '          newsSuccesNum--成功采集的信息数量
  11. '          newsFalseNum--失败采集的信息数量
  12. '          ImagesNum----图片数目
  13. '          ListPaingNext--列表分页
  14. Dim ItemNum,ListNum,newsNum,PaingNum,newsSuccesNum,newsFalseNum
  15. Dim Rs,Sql,RsItem,SqlItem,ItemEnd,ListEnd,newsEnd,PaingEnd,ErrMsg
  16.  
  17. '项目变量
  18. Dim ItemID,ItemName,ChannelID,strChannelDir,ClassID,SpecialID,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
  19. Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr
  20. Dim TsString,ToString,CsString,CoString,DateType,DsString,DoString,AuthorType,AsString,AoString,AuthorStr,CopyFromType,FsString,FoString
  21. Dim CopyFromStr,KeyType,KsString,KoString,KeyStr,newsPaingType,NPsString,NpoString,newsPaingStr,newsPaingHtml
  22. Dim ItemCollecDate,PaginationType,MaxCharPerPage,ReadLevel,Stars,ReadPoint,Hits,UpDateType,UpDateTime,IncludePicYn,DefaultPicYn,OnTop,Elite,Hot
  23. 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
  24.  
  25. '过滤变量
  26. Dim Arr_Filters,i_Filter,FilterStr,SqlF,RsF,Filteri
  27.  
  28. '采集相关的变量
  29. Dim ContentTemp,newsPaingNext,newsPaingNextCode,Arr_i,newsUrl,newsCode
  30.  
  31. '信息保存变量
  32. Dim ArticleID,Title,Content,Author,CopyFrom,Key,IncludePic,UploadFiles,DefaultPicUrl
  33.  
  34. '其它变量
  35. Dim LoginData,LoginResult,OrderTemp
  36. Dim Arr_Item,Arr_Other,CollecTest,Content_View,CacheTemp,CollecnewsAll
  37.  
  38. '历史记录
  39. Dim Arr_Histrolys,His_HistrolyID,His_Title,His_CollecDate,His_Result,His_Repeat,His_i
  40.  
  41. '执行时间变量
  42. Dim StartTime,OverTime
  43.  
  44. '图片统计
  45. Dim Arr_Images,ImagesNum,ImagesNumAll
  46.  
  47. '列表
  48. Dim ListUrl,ListCode,ListUrlArray,newsArrayCode,newsArray,ListArray,ListPaingNext,ListPaingTemp
  49.  
  50. Dim strInstallDir
  51. '获得动易安装文件夹
  52. strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
  53. strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
  54. strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/"))
  55.  
  56. CacheTemp=Lcase(trim(request.ServerVariables("SCRIPT_NAME")))
  57. CacheTemp=left(CacheTemp,instrrev(CacheTemp,"/"))
  58. CacheTemp=replace(CacheTemp,"\","_")
  59. CacheTemp=replace(CacheTemp,"/","_")
  60. CacheTemp="ansir" & CacheTemp
  61.  
  62. CollecnewsNum=0
  63. ArticleID=0
  64. ItemNum=Clng(Trim(Request("ItemNum")))
  65. ListNum=Clng(Trim(Request("ListNum")))
  66. newsSuccesNum=Clng(Trim(Request("newsSuccesNum")))
  67. newsFalseNum=Clng(Trim(Request("newsFalseNum")))
  68. ImagesNumAll=Trim(Request("ImagesNumAll"))
  69. ListPaingNext=Trim(Request("ListPaingNext"))
  70. If ImagesNumAll="" Then
  71.    ImagesNumAll=0
  72. Else
  73.    ImagesNumAll=Clng(ImagesNumAll)
  74. End If
  75. FoundErr=False
  76. ItemEnd=False
  77. ListEnd=False
  78.  
  79. Call SetCache
  80.  
  81. If ItemEnd<>True Then
  82.    If (ItemNum-1)>Ubound(Arr_Item,2) then
  83.       ItemEnd=True
  84.    Else
  85.       Call SetItems()
  86.    End If
  87. End If
  88.  
  89. If ItemEnd<>True Then
  90.    If ListPaingType=0 Then
  91.       If ListNum=1 Then
  92.          ListUrl=ListStr
  93.       Else
  94.          ListEnd=True
  95.       End If
  96.    ElseIf ListPaingType=1 Then
  97.       If ListNum=1 Then
  98.          ListUrl=ListStr
  99.       Else
  100.          If ListNum>CollecListNum And CollecListNum<>0 Then
  101.             ListEnd=True
  102.          Else
  103.             If ListPaingNext="" or ListPaingNext="$False$" Then
  104.                ListEnd=True
  105.             Else
  106.                ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
  107.                ListUrl=ListPaingNext
  108.             End If
  109.          End If
  110.       End If
  111.    ElseIf ListPaingType=2 Then
  112.       If (ListPaingID1+ListNum-1)>ListPaingID2 Then
  113.          ListEnd=True
  114.       Else
  115.          ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
  116.       End If
  117.    ElseIf ListPaingType=3  Then
  118.       ListArray=Split(ListPaingStr3,"|")
  119.       If (ListNum-1)>Ubound(ListArray) Then
  120.          ListEnd=True
  121.       Else
  122.          ListUrl=ListArray(ListNum-1)
  123.       End If    
  124.    End If
  125. End If
  126.  
  127. If ItemEnd=True Then
  128.    ErrMsg="<br>采集任务全部完成"
  129.    ErrMsg=ErrMsg & "<br>成功采集: "  &  newsSuccesNum  &  "  条,失败: "    &  newsFalseNum  &  "  条,图片:" & ImagesNumAll & "  张"
  130.    Call DelCache()
  131. Else
  132.    If ListEnd=True Then
  133.       ItemNum=ItemNum+1
  134.       ListNum=1
  135.       ErrMsg="<br>" & ItemName & "  项目所有列表采集完成,正在存取缓存请稍后..."
  136.       ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&newsSuccesNum=" & newsSuccesNum & "&newsFalseNum=" & newsFalseNum & "&ImagesNumAll=" & ImagesNumAll & """>"
  137.    End If
  138. End If
  139.  
  140. Call TopItem()
  141. If ItemEnd=True Or ListEnd=True Then
  142.    Call WriteSucced(ErrMsg)
  143. Else
  144.    FoundErr=False
  145.    ErrMsg=""
  146.    Call StartCollection()
  147.    Call FootItem2()
  148. End  If
  149. Response.Flush()
  150. '关闭数据库链接
  151. Call CloseConn()
  152. Call CloseConnItem()
  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 CollecTest=True  And  Arr_i=10 Then
  218.          'Exit For
  219.       'End If
  220.       If CollecnewsAll>=CollecnewsNum And CollecnewsNum<>0 Then
  221.          Exit For
  222.       End If
  223.       CollecnewsAll=CollecnewsAll+1
  224.       '变量初始化
  225.       UploadFiles=""
  226.       DefaultPicUrl=""
  227.       IncludePic=0
  228.       ImagesNum=0
  229.       newsCode=""
  230.       FoundErr=False
  231.       ErrMsg=""
  232.       His_Repeat=False
  233.       newsUrl=newsArray(Arr_i)
  234.       Title=""
  235.  
  236.       '………………………………………………
  237.       If Response.IsClientConnected Then
  238.          Response.Flush
  239.       Else
  240.          Response.End
  241.       End If
  242.       '………………………………………………
  243.  
  244.       If CollecTest=False Then
  245.          His_Repeat=CheckRepeat(newsUrl)
  246.       Else
  247.          His_Repeat=False
  248.       End If
  249.       If His_Repeat=True Then
  250.          FoundErr=True
  251.       End If
  252.  
  253.       If FoundErr<>True Then
  254.          newsCode=GetHttpPage(newsUrl)
  255.          If newsCode="$False$" Then
  256.             FoundErr=True
  257.             ErrMsg=ErrMsg & "<br><br>在获取:" & newsUrl & "信息源码时发生错误!"
  258.             Title="分析源码错误"
  259.          End If
  260.       End If
  261.  
  262.       If FoundErr<>True Then
  263.          Title=GetBody(newsCode,TsString,ToString,False,False)
  264.          If Title="$False$" or Title="" then
  265.             FoundErr=True
  266.             ErrMsg=ErrMsg & "<br><br>在分析:" & newsUrl & "的信息标题时发生错误"
  267.             Title="<br>标题分析错误"
  268.          End If
  269.          If FoundErr<>True Then
  270.             Content=GetBody(newsCode,CsString,CoString,False,False)
  271.             If Content="$False$" or Content="" Then
  272.                FoundErr=True
  273.                ErrMsg=ErrMsg & "<br><br>在分析:" & newsUrl & "的信息正文时发生错误"
  274.                Title=Title & "<br><br>正文分析错误"
  275.             End If
  276.          End If
  277.          If FoundErr<>True Then
  278.             '信息分页
  279.             If newsPaingType=1 Then
  280.                newsPaingNext=GetPaing(newsCode,NPsString,NPoString,False,False)
  281.                Do While newsPaingNext<>"$False$"
  282.                   If newsPaingStr="" or IsNull(newsPaingStr)=True Then
  283.                      newsPaingNext=DefiniteUrl(newsPaingNext,newsUrl)
  284.                   Else
  285.                      newsPaingNext=Replace(newsPaingStr,"{$ID}",newsPaingNext)
  286.                   End If
  287.                   If newsPaingNext="" or newsPaingNext="$False$" Then
  288.                      Exit Do
  289.                   End If
  290.                   newsPaingNextCode=GetHttpPage(newsPaingNext)                  
  291.                   ContentTemp=GetBody(newsPaingNextCode,CsString,CoString,False,False)
  292.                   If ContentTemp="$False$" Then
  293.                      Exit Do
  294.                   Else
  295.                      Content=Content & newsPaingHtml & ContentTemp
  296.                      newsPaingNext=GetPaing(newsPaingNextCode,NPsString,NPoString,False,False)
  297.                   End If
  298.                Loop
  299.             End If
  300.  
  301.             '过滤
  302.             Call Filters
  303.             Title=FpHtmlEnCode(Title)
  304.             Call FilterScript()
  305.             Content=Ubbcode(Content)
  306.          End If
  307.       End If
  308.  
  309.       '分开写(太长了照顾不过来)
  310.       If FoundErr<>True Then
  311.          '时间
  312.          If UpDateType=0 Then
  313.             UpDateTime=Now()
  314.          ElseIf UpDateType=1 Then
  315.             If DateType=0 then
  316.                UpDateTime=Now()
  317.             Else
  318.                UpDateTime=GetBody(newsCode,DsString,DoString,False,False)
  319.                UpDateTime=FpHtmlEncode(UpDateTime)
  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)
  369.          ElseIf KeyType=1 Then
  370.             Key=GetBody(newsCode,KsString,KoString,False,False)
  371.             Key=FpHtmlEncode(Key)
  372.             Key=CreateKeyWord(Key)
  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,strChannelDir,True,newsUrl)              
  389.          Else
  390.             Content=ReplaceSaveRemoteFile(Content,strInstallDir,strChannelDir,False,newsUrl)
  391.          End If
  392.  
  393.          '图片统计、信息图片属性设置
  394.          If UploadFiles<>"" Then
  395.             If Instr(UploadFiles,"|")>0 Then
  396.                Arr_Images=Split(UploadFiles,"|")
  397.                ImagesNum=Ubound(Arr_Images)+1
  398.                DefaultPicUrl=Arr_Images(0)
  399.             Else
  400.                ImagesNum=1
  401.                DefaultPicUrl=UploadFiles
  402.             End If
  403.  
  404.             If DefaultPicYn=False then
  405.                DefaultPicUrl=""
  406.             End If
  407.             If IncludePicYn=True Then
  408.                IncludePic=-1
  409.             Else
  410.                IncludePic=0
  411.             End If
  412.             If SaveFiles<>True Then
  413.                UploadFiles=""
  414.             End If
  415.          Else
  416.             ImagesNum=0
  417.             DefaultPicUrl=""
  418.             IncludePic=0        
  419.          End If
  420.          ImagesNumAll=ImagesNumAll+ImagesNum
  421.       End If
  422.  
  423.       If FoundErr<>True Then
  424.          If CollecTest=False Then
  425.             Call SaveArticle
  426.             SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,ArticleID,Title,CollecDate,newsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & Title & "','" & Now() & "','" & newsUrl & "',True)"
  427.             ConnItem.Execute(SqlItem)
  428.             Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & strChannelDir & "/")
  429.          End If
  430.          newsSuccesNum=newsSuccesNum+1
  431.          ErrMsg=ErrMsg & "No:<font color=red>" & newsSuccesNum+newsFalseNum & "</font><br>"
  432.          ErrMsg=ErrMsg & "信息标题:"
  433.          ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
  434.          ErrMsg=ErrMsg & "更新时间:" & UpDateTime & "<br>"
  435.          ErrMsg=ErrMsg & "信息作者:" & Author & "<br>"
  436.          ErrMsg=ErrMsg & "信息来源:" & CopyFrom & "<br>"
  437.          ErrMsg=ErrMsg & "采集页面:<a href=" & newsUrl & " target=_blank>" & newsUrl & "</a><br>"
  438.          ErrMsg=ErrMsg & "图片信息:图片 " & ImagesNum & " 张<br>"
  439.          ErrMsg=ErrMsg & "正文预览:"
  440.          If Content_View=True Then
  441.             ErrMsg=ErrMsg & "<br>" & Content
  442.          Else
  443.             ErrMsg=ErrMsg & "您没有启用正文预览功能"
  444.          End If
  445.          ErrMsg=ErrMsg & "<br><br>关 键 字:" & Key & ""
  446.       Else
  447.          newsFalseNum=newsFalseNum+1
  448.          If His_Repeat=True Then
  449.             ErrMsg=ErrMsg & "No:<font color=red>" & newsSuccesNum+newsFalseNum & "</font><br>"
  450.             ErrMsg=ErrMsg & "目标信息:<font color=red>"
  451.             If His_Result=True Then
  452.                ErrMsg=ErrMsg & His_Title
  453.             Else
  454.                ErrMsg=ErrMsg & newsUrl
  455.             End If
  456.             ErrMsg=ErrMsg & "</font><br>"
  457.  
  458.             ErrMsg=ErrMsg & "采集时间:" & His_CollecDate & "<br>"
  459.             ErrMsg=ErrMsg & "信息来源:<a href='" & newsUrl & "' target=_blank>"&newsUrl&"</a><br>"
  460.             ErrMsg=ErrMsg & "采集结果:"
  461.             If His_Result=False Then
  462.                ErrMsg=ErrMsg & "失败"
  463.                ErrMsg=ErrMsg & "<br>失败原因:" & Title
  464.             Else
  465.                ErrMsg=ErrMsg & "成功"
  466.             End If            
  467.             ErrMsg=ErrMsg & "<br>提示信息:如想再次采集,请先将该信息的历史记录<font color=red>删除</font><br>"
  468.          End If
  469.          If CollecTest=False And His_Repeat=False Then
  470.             SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,Title,CollecDate,newsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & Title & "','" & Now() & "','" & newsUrl & "',False)"
  471.             ConnItem.Execute(SqlItem)
  472.          End If
  473.       End If
  474.       Call ShowMsg(ErrMsg)
  475.       Response.Flush()'刷新
  476.    Next
  477. Else
  478.    Call ShowMsg(ErrMsg)
  479. End If
  480.  
  481. Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
  482. Response.Write "<tr>"
  483. Response.write "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
  484. If CollecTest=False Then
  485.    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>"
  486.    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  & """>"
  487. Else
  488.    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>"
  489. End If
  490. Response.Write "</td></tr>"
  491. Response.Write "</table>"
  492. End Sub
  493.  
  494.  
  495.  
  496. '==================================================
  497. '过程名:SetCache
  498. '作  用:获取变量
  499. '参  数:无
  500. '==================================================
  501. Sub SetCache()
  502.    Dim myCache
  503.    Set myCache=new clsCache
  504.  
  505.    '项目信息
  506.    myCache.name=CacheTemp & "items"
  507.    If myCache.valid then
  508.       Arr_Item=myCache.value
  509.    Else
  510.       ItemEnd=True
  511.       FoundErr=True
  512.       ErrMsg="<br><br><li>参数错误,请重新运行!</li>"
  513.    End If
  514.  
  515.    '过滤信息
  516.    myCache.name=CacheTemp & "filters"
  517.    If myCache.valid then
  518.       Arr_Filters=myCache.value
  519.    End If
  520.  
  521.    '历史记录
  522.    myCache.name=CacheTemp & "histrolys"
  523.    If myCache.valid then
  524.       Arr_Histrolys=myCache.value
  525.    End If
  526.  
  527.    '其它信息
  528.    myCache.name=CacheTemp & "collectest"
  529.    If myCache.valid then
  530.       CollecTest=myCache.value
  531.    Else
  532.       CollecTest=False
  533.    End If
  534.  
  535.    myCache.name=CacheTemp & "contentview"
  536.    If myCache.valid then
  537.       Content_View=myCache.value
  538.    Else
  539.       Content_View=False
  540.    End If
  541.  
  542.    Set myCache=Nothing
  543. End Sub
  544.  
  545. Sub DelCache()
  546.    Dim myCache
  547.    Set myCache=new clsCache
  548.    myCache.name=CacheTemp & "items"
  549.    Call myCache.clean()
  550.    myCache.name=CacheTemp & "filters"
  551.    Call myCache.clean()
  552.    myCache.name=CacheTemp & "histrolys"
  553.    Call myCache.clean()
  554.    myCache.name=CacheTemp & "collectest"
  555.    Call myCache.clean()
  556.    myCache.name=CacheTemp & "contentview"
  557.    Call myCache.clean()
  558. End Sub
  559.  
  560. '==================================================
  561. '过程名:SetItems
  562. '作  用:获取项目信息
  563. '参  数:无
  564. '==================================================
  565. Sub SetItems()
  566.       Dim ItemNumTemp
  567.       ItemNumTemp=ItemNum-1
  568.       ItemID=Arr_Item(0,ItemNumTemp)
  569.       ItemName=Arr_Item(1,ItemNumTemp)
  570.       ChannelID=Arr_Item(2,ItemNumTemp)'频道ID
  571.       strChannelDir=Arr_Item(3,ItemNumTemp)'频道目录
  572.       ClassID=Arr_Item(4,ItemNumTemp)            '栏目
  573.       SpecialID=Arr_Item(5,ItemNumTemp)        '专题
  574.       LoginType=Arr_Item(9,ItemNumTemp)
  575.       LoginUrl=Arr_Item(10,ItemNumTemp)          '登录
  576.       LoginPostUrl=Arr_Item(11,ItemNumTemp)
  577.       LoginUser=Arr_Item(12,ItemNumTemp)
  578.       LoginPass=Arr_Item(13,ItemNumTemp)
  579.       LoginFalse=Arr_Item(14,ItemNumTemp)
  580.       ListStr=Arr_Item(15,ItemNumTemp)            '列表地址
  581.       LsString=Arr_Item(16,ItemNumTemp)          '列表
  582.       LoString=Arr_Item(17,ItemNumTemp)
  583.       ListPaingType=Arr_Item(18,ItemNumTemp)
  584.       LPsString=Arr_Item(19,ItemNumTemp)          
  585.       LPoString=Arr_Item(20,ItemNumTemp)
  586.       ListPaingStr1=Arr_Item(21,ItemNumTemp)
  587.       ListPaingStr2=Arr_Item(22,ItemNumTemp)
  588.       ListPaingID1=Arr_Item(23,ItemNumTemp)
  589.       ListPaingID2=Arr_Item(24,ItemNumTemp)
  590.       ListPaingStr3=Arr_Item(25,ItemNumTemp)
  591.       HsString=Arr_Item(26,ItemNumTemp)  
  592.       HoString=Arr_Item(27,ItemNumTemp)
  593.       HttpUrlType=Arr_Item(28,ItemNumTemp)
  594.       HttpUrlStr=Arr_Item(29,ItemNumTemp)
  595.       TsString=Arr_Item(30,ItemNumTemp)          '标题
  596.       ToString=Arr_Item(31,ItemNumTemp)
  597.       CsString=Arr_Item(32,ItemNumTemp)          '正文
  598.       CoString=Arr_Item(33,ItemNumTemp)
  599.       DateType=Arr_Item(34,ItemNumTemp)      '作者
  600.       DsString=Arr_Item(35,ItemNumTemp)          
  601.       DoString=Arr_Item(36,ItemNumTemp)
  602.       AuthorType=Arr_Item(37,ItemNumTemp)      '作者
  603.       AsString=Arr_Item(38,ItemNumTemp)          
  604.       AoString=Arr_Item(39,ItemNumTemp)
  605.       AuthorStr=Arr_Item(40,ItemNumTemp)
  606.       CopyFromType=Arr_Item(41,ItemNumTemp)  '来源
  607.       FsString=Arr_Item(42,ItemNumTemp)          
  608.       FoString=Arr_Item(43,ItemNumTemp)
  609.       CopyFromStr=Arr_Item(44,ItemNumTemp)
  610.       KeyType=Arr_Item(45,ItemNumTemp)            '关键词
  611.       KsString=Arr_Item(46,ItemNumTemp)          
  612.       KoString=Arr_Item(47,ItemNumTemp)
  613.       KeyStr=Arr_Item(48,ItemNumTemp)
  614.       newsPaingType=Arr_Item(49,ItemNumTemp)            '关键词
  615.       NPsString=Arr_Item(50,ItemNumTemp)          
  616.       NPoString=Arr_Item(51,ItemNumTemp)
  617.       newsPaingStr=Arr_Item(52,ItemNumTemp)
  618.       newsPaingHtml=Arr_Item(53,ItemNumTemp)
  619.       ItemCollecDate=Arr_Item(54,ItemNumTemp)
  620.       PaginationType=Arr_Item(56,ItemNumTemp)
  621.       MaxCharPerPage=Arr_Item(57,ItemNumTemp)
  622.       ReadLevel=Arr_Item(58,ItemNumTemp)
  623.       Stars=Arr_Item(59,ItemNumTemp)
  624.       ReadPoint=Arr_Item(60,ItemNumTemp)
  625.       Hits=Arr_Item(61,ItemNumTemp)
  626.       UpDateType=Arr_Item(62,ItemNumTemp)
  627.       UpDateTime=Arr_Item(63,ItemNumTemp)
  628.       IncludePicYn=Arr_Item(64,ItemNumTemp)
  629.       DefaultPicYn=Arr_Item(65,ItemNumTemp)
  630.       OnTop=Arr_Item(66,ItemNumTemp)
  631.       Elite=Arr_Item(67,ItemNumTemp)
  632.       Hot=Arr_Item(68,ItemNumTemp)
  633.       SkinID=Arr_Item(69,ItemNumTemp)
  634.       TemplateID=Arr_Item(70,ItemNumTemp)
  635.       Script_Iframe=Arr_Item(71,ItemNumTemp)
  636.       Script_Object=Arr_Item(72,ItemNumTemp)
  637.       Script_Script=Arr_Item(73,ItemNumTemp)
  638.       Script_Div=Arr_Item(74,ItemNumTemp)
  639.       Script_Class=Arr_Item(75,ItemNumTemp)
  640.       Script_Span=Arr_Item(76,ItemNumTemp)
  641.       Script_Img=Arr_Item(77,ItemNumTemp)
  642.       Script_Font=Arr_Item(78,ItemNumTemp)
  643.       Script_A=Arr_Item(79,ItemNumTemp)
  644.       Script_Html=Arr_Item(60,ItemNumTemp)
  645.       CollecListNum=Arr_Item(81,ItemNumTemp)
  646.       CollecnewsNum=Arr_Item(82,ItemNumTemp)
  647.       Passed=Arr_Item(83,ItemNumTemp)
  648.       SaveFiles=Arr_Item(84,ItemNumTemp)
  649.       CollecOrder=Arr_Item(85,ItemNumTemp)
  650.       LinkUrlYn=Arr_Item(86,ItemNumTemp)
  651.       InputerType=Arr_Item(87,ItemNumTemp)
  652.       Inputer=Arr_Item(88,ItemNumTemp)
  653.       EditorType=Arr_Item(89,ItemNumTemp)
  654.       Editor=Arr_Item(90,ItemNumTemp)
  655.       ShowCommentLink=Arr_Item(91,ItemNumTemp)
  656.       If InputerType=1 Then
  657.          Inputer=FpHtmlEnCode(Inputer)
  658.       Else
  659.          Inputer=session("AdminName")
  660.       End If
  661.       If EditorType=1 Then
  662.          Editor=FpHtmlEnCode(Editor)
  663.       Else
  664.          Editor=session("AdminName")
  665.       End If
  666.       If IsObjInstalled("Scripting.FileSystemObject")=False or strChannelDir="" Then
  667.          SaveFiles=False
  668.       End if
  669. End Sub
  670.  
  671. '==================================================
  672. '过程名:GetListPaing
  673. '作  用:获取列表下一页
  674. '参  数:无
  675. '==================================================
  676. Sub GetListPaing()
  677.    If ListPaingType=1 Then
  678.       ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
  679.       If ListPaingNext<>"$False$"  Then
  680.          If ListPaingStr1<>""  Then  
  681.             ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
  682.          Else
  683.             ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
  684.          End If
  685.          ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
  686.       End If
  687.    Else
  688.       ListPaingNext="$False$"
  689.    End If
  690. End Sub
  691.  
  692. '==================================================
  693. '过程名:SaveArticle
  694. '作  用:保存信息
  695. '参  数:无
  696. '==================================================
  697. 'Sub SaveArticle
  698. 'if ChannelID=1 then
  699. '   set rs=server.createobject("adodb.recordset")
  700. '   sql="select top 1 * from news"
  701. '   rs.open sql,conn,1,3
  702. '   rs.addnew
  703. '   rs("typeID")=ClassID
  704. '   rs("Title")=Title
  705. '   rs("Content")=Content
  706. '   rs("Hits")=Hits
  707. '   rs("Nfrom")="人才网信息中心"
  708. '   rs("Picture")="nopicture.gif"
  709. '   rs("dateandTime")=UpDateTime
  710. '   rs.update
  711. '   rs.close
  712. '   set rs=nothing
  713. 'elseif ChannelID=2 then
  714. '   set rs=server.createobject("adodb.recordset")
  715. '   sql="select top 1 * from expoinfo"
  716. '   rs.open sql,conn,1,3
  717. '   rs.addnew
  718. '   rs("typeID")=ClassID
  719. '   rs("Title")=Title
  720. '   rs("Content")=Content
  721. '   rs("Nfrom")="人才网信息中心"
  722. '   rs("Picture")="nopicture.gif"
  723. '   rs("dateandTime")=UpDateTime
  724. '   rs.update
  725. '   rs.close
  726. '   set rs=nothing
  727. 'end if
  728. 'End Sub
  729.  
  730.  
  731. '==================================================
  732. '过程名:Filters
  733. '作  用:过滤
  734. '==================================================
  735. Sub Filters()
  736. If IsNull(Arr_Filters)=True or IsArray(Arr_Filters)=False Then
  737.    Exit Sub
  738. End if
  739.  
  740.    For Filteri=0 to Ubound(Arr_Filters,2)
  741.       If Arr_Filters(3,Filteri)=1 Then'标题过滤
  742.          If Arr_Filters(4,Filteri)=1 Then
  743.             Title=Replace(Title,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
  744.          ElseIf Arr_Filters(4,Filteri)=2 Then
  745.             FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  746.             Do While FilterStr<>"$False$"
  747.                Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
  748.                FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  749.             Loop
  750.          End If
  751.       ElseIf Arr_Filters(3,Filteri)=2 Then'正文过滤
  752.          If Arr_Filters(4,Filteri)=1 Then
  753.             Content=Replace(Content,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
  754.          ElseIf Arr_Filters(4,Filteri)=2 Then
  755.             FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  756.             Do While FilterStr<>"$False$"
  757.                Content=Replace(Content,FilterStr,Arr_Filters(8,Filteri))
  758.                FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
  759.             Loop
  760.          End If
  761.       End If
  762.    Next
  763. End Sub
  764.  
  765. '==================================================
  766. '过程名:FilterScript
  767. '作  用:脚本过滤
  768. '==================================================
  769.  
  770. Sub  FilterScript()
  771.    If Script_Iframe=True Then
  772.       Content=ScriptHtml(Content,"Iframe",1)
  773.    End If
  774.    If Script_Object=True Then
  775.       Content=ScriptHtml(Content,"Object",2)
  776.    End If
  777.    If Script_Script=True Then
  778.       Content=ScriptHtml(Content,"Script",2)
  779.    End If
  780.    If Script_Div=True Then
  781.       Content=ScriptHtml(Content,"Div",3)
  782.    End If
  783.    If Script_Span=True Then
  784.       Content=ScriptHtml(Content,"Span",3)
  785.    End If
  786.    If Script_Img=True Then
  787.       Content=ScriptHtml(Content,"Img",3)
  788.    End If
  789.    If Script_Font=True Then
  790.       Content=ScriptHtml(Content,"Font",3)
  791.    End If
  792.    If Script_A=True Then
  793.       Content=ScriptHtml(Content,"A",3)
  794.    End If
  795.    If Script_Html=True Then
  796.       Content=noHtml(Content)
  797.    End If
  798. End  Sub
  799.  
  800. '==================================================
  801. '过程名:TopItem
  802. '作  用:显示导航信息
  803. '参  数:无
  804. '==================================================
  805. Sub TopItem()%>
  806. <html>
  807. <head>
  808. <title>信息采集系统</title>
  809. <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
  810. <link rel="stylesheet" type="text/css" href="../style/Style.css">
  811. </head>
  812. <body>
  813. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">
  814.   <tr>
  815.     <td class="td28">采集系统采集理管理</td>
  816.   </tr>
  817.   <tr class="td26" bgcolor="#FFFFFF">
  818.     <td><b>管理导航:</b><a href="Admin_ItemStart.asp">管理首页</a> >> 信息采集</td>
  819.   </tr>
  820. </table>
  821. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">    
  822.   <tr>
  823.     <td bgcolor="#FFFFFF" aling="center" style="padding:4px; line-height:30px;">采集需要一定的时间,请耐心等待,如果网站出现暂时无法访问的情况这是正常的,采集正常结束后即可恢复。</td>
  824.   </tr>
  825. </table>
  826. <%End Sub%>
  827.  
  828. <%
  829. Sub TopItem2%>
  830. <table width="98%" align="center" border="0" cellpadding="0" cellspacing="1" bgcolor="#8ED1FF" class="mtab">  
  831.     <tr>
  832.       <td bgcolor="#FFFFFF">本次运行:<%=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> 条。
  833.       <br><br>采集统计:成功采集--<%=newsSuccesNum%>  条信息,失败--<%=newsFalseNum%>  条,图片--<%=ImagesNumAll%> 张。
  834.       </td>
  835.     </tr>
  836. </table>
  837. <%StartTime=Timer()%>
  838. <%End Sub%>
  839.  
  840. <%
  841. '==================================================
  842. '过程名:FootItem2
  843. '作  用:显示该列表采集时间等信息
  844. '参  数:无
  845. '==================================================
  846. Sub FootItem2()
  847.    Dim strTemp
  848.    OverTime=Timer()
  849.    strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"      
  850.    strTemp=strTemp & "<tr>"          
  851.    strTemp=strTemp & "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
  852.    strTemp=strTemp & "执行时间:" & CStr(FormatNumber((OverTime-StartTime)*1000,2)) & " 毫秒"
  853.    strTemp=strTemp & "</td></tr><br>"
  854.    strTemp=strTemp & "</table>"
  855.    Response.write strTemp
  856. End Sub
  857.  
  858. '==================================================
  859. '过程名:ShowMsg
  860. '作  用:显示信息
  861. '参  数:无
  862. '==================================================
  863. Sub ShowMsg(Msg)
  864.    Dim strTemp
  865.    strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"      
  866.    strTemp=strTemp & "   <tr class='tdbg'>"          
  867.    strTemp=strTemp & "      <td height=""22"" colspan=""2"" align=""left"">"
  868.    strTemp=strTemp & Msg
  869.    strTemp=strTemp & "      </td>"
  870.    strTemp=strTemp & "   </tr><br>"
  871.    strTemp=strTemp & "</table>"
  872.    Response.Write StrTemp    
  873. End Sub
  874.  
  875. Function CheckRepeat(strUrl)
  876.    CheckRepeat=False
  877.    If IsArray(Arr_Histrolys)=True then
  878.       For His_i=0 to Ubound(Arr_Histrolys,2)
  879.          If Arr_Histrolys(0,His_i)=strUrl Then
  880.             CheckRepeat=True
  881.             His_Title=Arr_Histrolys(1,His_i)
  882.             His_CollecDate=Arr_Histrolys(2,His_i)
  883.             His_Result=Arr_Histrolys(3,His_i)
  884.             Exit For
  885.          End If
  886.       Next
  887.    End If
  888. End Function
  889. %>
  890.  
  891.  
  892.  
  893.  
downloadAdmin_ItemCollecScreen.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