📄 admin_collection.asp
字号:
ListPaingNext = Replace(ListPaingNext, "&", "{$ID}")
End If
End If
Else
ListPaingNext = "$False$"
End If
If ListCode = "$False$" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>在获取：" & ListUrl & "网页源码时发生错误！</li>"
Else
ListCode = GetBody(ListCode, LsString, LoString, False, False) '截取列表字符串
If ListCode = "$False$" Or ListCode = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>在截取：" & ListUrl & "列表时发生错误！</li>"
End If
End If
End If
If FoundErr <> True Then
NewsArrayCode = GetArray(ListCode, HsString, HoString, False, False) 'NewsArrayCode=在列表中提取链接地址
If ThumbnailType = 1 Then
ThumbnailArrayCode = GetArray(ListCode, ThsString, ThoString, False, False) '缩略图地址
End If
End If
If NewsArrayCode = "$False$" Or FoundErr = True Then
FoundErr = True
ErrMsg = ErrMsg & "<li>在分析：" & ListUrl & "新闻列表时发生错误！</li>"
ItemNum = ItemNum + 1
ListNum = 1
ArticleList = ""
'生成Html
Call GetArrOfCreateHTML
Response.Write " <meta http-equiv=""refresh"" content=" & TimeNum & ";url=""Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&CollecNewsj=" & CollecNewsj & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
Call WriteErrMsg(ErrMsg, ComeUrl)
Exit Sub
Else
'分割链接文章地址
NewsArray = Split(NewsArrayCode, "$Array$")
For Arr_j = 0 To UBound(NewsArray)
'当链接地址要从新定位时？
If HttpUrlType = 1 Then
NewsArray(Arr_j) = Trim(Replace(HttpUrlStr, "{$ID}", NewsArray(Arr_j)))
Else
'过滤空格并将相对地址转换为绝对地址
NewsArray(Arr_j) = Trim(DefiniteUrl(NewsArray(Arr_j), ListUrl))
End If
Next
If PE_CLng(CollecOrder) = 1 Then '如果是倒序采集
'颠倒当前数组的顺序
For Arr_j = 0 To Fix(UBound(NewsArray) / 2)
OrderTemp = NewsArray(Arr_j)
NewsArray(Arr_j) = NewsArray(UBound(NewsArray) - Arr_j)
NewsArray(UBound(NewsArray) - Arr_j) = OrderTemp
Next
End If
'列表缩略图地址
If ThumbnailType = 1 Then
'分割链接文章地址
ThumbnailArray = Split(ThumbnailArrayCode, "$Array$")
For Arr_j = 0 To UBound(ThumbnailArray)
'过滤空格并将相对地址转换为绝对地址
ThumbnailArray(Arr_j) = Trim(DefiniteUrl(ThumbnailArray(Arr_j), ListUrl))
Next
If PE_CLng(CollecOrder) = 1 Then '如果是倒序采集
'颠倒当前数组的顺序
For Arr_j = 0 To Fix(UBound(ThumbnailArray) / 2)
OrderTemp = ThumbnailArray(Arr_j)
ThumbnailArray(Arr_j) = ThumbnailArray(UBound(ThumbnailArray) - Arr_j)
ThumbnailArray(UBound(ThumbnailArray) - Arr_j) = OrderTemp
Next
End If
PE_Cache.SetValue "ThumbnailList" & rnd_temp, ThumbnailArray '加载缓存
End If
PE_Cache.SetValue "ArticleList" & rnd_temp, NewsArray '加载缓存
'更新断点记录
sql = "select Timing_Breakpoint from PE_config"
Set rs = Server.CreateObject("adodb.recordset")
rs.Open sql, Conn, 1, 3
rs("Timing_Breakpoint") = " <meta http-equiv=""refresh"" content=0;url=""Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
rs.Update
rs.Close
Set rs = Nothing
Response.Write " <meta http-equiv=""refresh"" content=0;url=""Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
Exit Sub
End If
Else
'生成Html
Call GetArrOfCreateHTML
ErrMsg = ErrMsg & "<br><font color=red>" & ItemName & "</font> 项目采集任务完成！</li>"
Call WriteSuccessMsg2(ErrMsg)
Exit Sub
End If
Else
NewsArray = PE_Cache.GetValue("ArticleList" & rnd_temp)
If ThumbnailType = 1 Then
ThumbnailArray = PE_Cache.GetValue("ThumbnailList" & rnd_temp)
End If
End If
'加载导航信息
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >" & vbCrLf
Response.Write " <tr> " & vbCrLf
Response.Write " <td height=""22"" colspan=""2"" class=""tdbg"" align=""left""> 采集需要一定的时间,请耐心等待,如果网站出现暂时无法访问的情况这是正常的,采集过程正常结束后即可恢复。" & vbCrLf
Response.Write " <input type=""button"" name=""Stop"" value=""停止采集"" onCLICK=""location.href='Admin_Collection.asp?Action=StopCollection&rnd_temp=" & rnd_temp & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&CollectionCreateHTML=" & CollectionCreateHTML & "&ChannelID=" & ChannelID & "&ClassID=" & ClassID & "&SpecialID=" & SpecialID & "&CreateImmediate=" & CreateImmediate & "&UseCreateHTML=" & UseCreateHTML & "&TimingCreate=" & TimingCreate & "'"">" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
'加载显示采集全局信息
Response.Write " <tr>" & vbCrLf
Response.Write " <td height=""22"" colspan=""2"" class=""tdbg"" align=""left""> 本次运行：" & UBound(ItemIDArray) + 1 & " 个项目,正在采集第 <font color=red>" & ItemNum & "</font> 个项目 <font color=red>" & ItemName & "</font> 的第 <font color=red>" & ListNum & "</font> 页列表,该列表待采集新闻 <font color=red>" & UBound(NewsArray) + 1 & "</font> 条,中的第 <font color=red>" & Arr_i + 1 & "</font> 条。" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>"
Response.Write " <td height=""22"" colspan=""2"" class=""tdbg"" align=""left""> 采集统计：成功采集--" & CollecNewsi & " 条新闻,失败--" & CollecNewsj & " 条,图片--" & ImagesNumAll & "</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Response.Write "<br>"
StartTime = Timer()
If CollecType = 0 Then
'执行核心采集过程
Call StartCollection
'………………………………………………
'采集数处理 当前列表采集完成 or 指定数完成
If CollectionType = 0 And CollectionNum <> "" Then
If CLng(ItemSucceedNum2) >= CLng(CollectionNum) Then
'生成Html
Call GetArrOfCreateHTML
ListNum = ListNum + 1
ArticleList = ""
ItemSucceedNum2 = 0 '统计数采集项目都清0为下一个采集项目准备
Else
Arr_i = Arr_i + 1 '移动到下一采集文章
End If
ElseIf CollectionType = 1 And CollectionNum <> "" Then
If ListNum > PE_CLng(CollectionNum) Then
ArticleList = "" '采集列表完成
'生成Html
Call GetArrOfCreateHTML
ItemSucceedNum2 = 0 '统计数采集项目都清0为下一个采集项目准备
Else
Arr_i = Arr_i + 1 '移动到下一采集文章
End If
Else
Arr_i = Arr_i + 1 '移动到下一采集文章
End If
If Arr_i > UBound(NewsArray) Then
Arr_i = 0
ListNum = ListNum + 1
ArticleList = "" '采集列表完成
End If
Else
For Arr_i = 0 To UBound(NewsArray)
FoundErr = False
Call StartCollection '执行核心采集过程
'采集数处理 当前列表采集完成 or 指定数完成
If CollectionType = 0 And CollectionNum <> "" Then
If CLng(ItemSucceedNum2) >= CLng(CollectionNum) Then
ListNum = ListNum + 1
ArticleList = ""
'生成Html
Call GetArrOfCreateHTML
ItemSucceedNum2 = 0 '统计数采集项目都清0为下一个采集项目准备
Exit For
End If
ElseIf PE_CLng(CollectionType) = 1 And CollectionNum <> "" Then
If ListNum = PE_CLng(CollectionNum) And Arr_i >= UBound(NewsArray) Then
ListNum = ListNum + 1
ArticleList = "" '采集列表完成
'生成Html
Call GetArrOfCreateHTML
ItemSucceedNum2 = 0 '统计数采集项目都清0为下一个采集项目准备
Exit For
End If
End If
If Arr_i >= UBound(NewsArray) Then
Arr_i = 0
ListNum = ListNum + 1
ArticleList = "" '采集列表完成
Exit For
End If
Next
End If
End If
Response.Write "<br>"
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >" & vbCrLf
Response.Write " <tr>"
Response.Write " <td height=""22"" align=""left"" class=""tdbg"">"
Response.Write " 数据整理中," & TimeNum & " 秒后继续......" & TimeNum & "秒后如果还没反应请点击 <a href='Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & "'><font color=red>这里</font></a> 继续<br>"
Response.Write " <meta http-equiv=""refresh"" content=" & TimeNum & ";url=""Admin_Collection.asp?Action=Start&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&Arr_i=" & Arr_i & "&CollecNewsA=" & CollecNewsA & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemIDtemp=" & ItemIDtemp & "&rnd_temp=" & rnd_temp & "&ArticleList=" & ArticleList & "&ItemSucceedNum=" & ItemSucceedNum & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&ItemID=" & ItemIDStr & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&ListPaingNext=" & ListPaingNext & "&CollectionCreateHTML=" & CollectionCreateHTML & "&Timing_AreaCollection=" & Timing_AreaCollection & "&TimingCreate=" & TimingCreate & """>"
Response.Write " 执行时间：" & CStr(FormatNumber((Timer() - StartTime) * 1000, 2)) & " 毫秒"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write " <tr> " & vbCrLf
Response.Write " <td height=""22"" class=""tdbg"" align=""left""> 采集需要一定的时间,请耐心等待,如果网站出现暂时无法访问的情况这是正常的,采集过程正常结束后即可恢复。" & vbCrLf
Response.Write " <input type=""button"" name=""Stop"" value=""停止采集"" onCLICK=""location.href='Admin_Collection.asp?Action=StopCollection&rnd_temp=" & rnd_temp & "&CollecNewsi=" & CollecNewsi & "&CollecNewsj=" & CollecNewsj & "&IsTitle=" & Trim(Request("IsTitle")) & "&IsLink=" & Trim(Request("IsLink")) & "&ItemSucceedNum2=" & ItemSucceedNum2 & "&ImagesNumAll=" & ImagesNumAll & "&CollecType=" & CollecType & "&CollecTest=" & Trim(Request("CollecTest")) & "&Content_view=" & Trim(Request("Content_view")) & "&CollectionCreateHTML=" & CollectionCreateHTML & "&ChannelID=" & ChannelID & "&ClassID=" & ClassID & "&SpecialID=" & SpecialID & "&CreateImmediate=" & CreateImmediate & "&UseCreateHTML=" & UseCreateHTML & "&TimingCreate=" & TimingCreate & "'"">" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
End Sub
'==================================================
'过程名：StartCollection
'作 用：开始采集
'参 数：无
'==================================================
Sub StartCollection()
'………………………………………………
'内容页变量初始化
CollecNewsA = CollecNewsA + 1 '已经采集数（包含成功和失败）
DefaultPicUrl = "" '要采集的绝对路径
ImagesNum = 0 '本次采集采集到的图片数量
NewsCode = "" '获得内容也的源代码
Title = "" '标题
Content = "" '正文
Author = "" '作者
CopyFrom = "" '来源
Key = "" '关键字
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -