📄 admin_collectionrun.asp
字号:
Keyword = ""
Author = ""
Copyfrom = ""
UpdateTime = ""
Content = ""
PageInfo = 1
PictrueNum = 0
SourceContent = ""
TargetURL = EL_Collection.ConvertURL(ArrListItemURL(i), tURL)
SourceContent = EL_Collection.GetURLSource(TargetURL, ArrCharset(Charset))
Call CheckError(SourceContent, RequestError, ErrorMsg, "获取信息源["& TargetURL &"]时发生错误")
If RequestError = False Then Title = EL_Collection.GetBody(SourceContent, TitleBegin, TitleEnd, False, False)
Call CheckError(Title, RequestError, ErrorMsg, "获取信息标题时发生错误")
If RequestError = False Then
If KeywordType = 0 Then
Keyword = KeywordString
Else
Keyword = EL_Collection.GetBody(SourceContent, KeywordBegin, KeywordEnd, False, False)
End If
If AuthorType = 0 Then
Author = AuthorString
Else
Author = EL_Collection.GetBody(SourceContent, AuthorBegin, AuthorEnd, False, False)
End If
If CopyfromType = 0 Then
Copyfrom = CopyfromString
Else
Copyfrom = EL_Collection.GetBody(SourceContent, CopyfromBegin, CopyfromEnd, False, False)
End If
If UpdateTimeType = 0 Then
UpdateTime = Now()
Else
UpdateTime = EL_Collection.GetBody(SourceContent, UpdateTimeBegin, UpdateTimeEnd, False, False)
End If
End If
If RequestError = False Then Content = EL_Collection.GetBody(SourceContent, ContentBegin, ContentEnd, False, False)
Call CheckError(Content, RequestError, ErrorMsg, "获取信息正文时发生错误")
If RequestError = False Then
Dim Watermark, FirstThumb, SRIType, Uploadfiles
If CollectionType = 1 And EL_Common.FoundInArray(TempArrSetting, 15) = True Then
SRIType = True
Else
SRIType = False
End If
Uploadfiles = ""
Watermark = EL_Common.FoundInArray(TempArrSetting, 16)
FirstThumb = EL_Common.FoundInArray(TempArrSetting, 17)
Content = FliterContent(Content, TempArrSetting)
Content = EL_Collection.ReplaceSaveRemoteFile(Content, InstallDir, EL_Channel.ChannelDir, EL_Channel.UploadDir, SRIType, TargetURL, PictrueNum, Watermark, FirstThumb, Uploadfiles)
If ContentPType = 0 Then
PageInfo = 1
Else
Dim ContentPString, ArrContentPURL, CPI, TempContent, TempContentPURL, TempSourceContent
ContentPString = EL_Collection.GetBody(SourceContent, ContentPBegin, ContentPEnd, False, False)
If ContentPString = "$RequestError" Then
PageInfo = 1
Else
ArrContentPURL = EL_Collection.GetArray(ContentPString, ContentPURLBegin, ContentPURLEnd, False, False)
PageInfo = Ubound(ArrContentPURL)
For CPI = 1 To PageInfo '采集内容分页, 第2页开始
TempContentPURL = EL_Collection.ConvertURL(ArrContentPURL(CPI), TargetURL)
TempSourceContent = EL_Collection.GetURLSource(TempContentPURL, ArrCharset(Charset))
If TempSourceContent <> "$RequetError" Then
TempContent = EL_Collection.GetBody(TempSourceContent, ContentBegin, ContentEnd, False, False)
If TempContent <> "$RequestError" Then
TempContent = FliterContent(TempContent, TempArrSetting)
TempContent = EL_Collection.ReplaceSaveRemoteFile(TempContent, InstallDir, EL_Channel.ChannelDir, EL_Channel.UploadDir, SRIType, TempContentPURL, PictrueNum, Watermark, FirstThumb, Uploadfiles)
Content = Content &"<P> </P><P>[NextPage]</P><P> </P>"& TempContent
End If
End If
Next
End If
End If
End If
If RequestError = True Then
FailNum = FailNum + 1
Else
Call Fliter()
SuccNum = SuccNum + 1
If CollectionType = 1 Then
Call InputData(ChannelID, ClassID, Title, Keyword, Author, Copyfrom, UpdateTime, Content, Uploadfiles, Hits, OnTop, Commended, Passed, SkinID, TemplateID, "")
End If
End if
ListNum = ListNum + 1
Call ShowItem(ListNum, Title, Keyword, Author, Copyfrom, UpdateTime, Content, TargetURL, PageInfo, PictrueNum, RequestError, ErrorMsg)
If CollectionNum>0 Then
If ListNum>=CollectionNum Then
NextPageURL = "$TheEnd"
Exit For
End If
End If
Next
If CollectionType = 1 Then Set ArticleCmd = Nothing
EndTime=Timer()
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" class=""Border"">"
Response.Write "<tr>"
Response.write "<td class=""td_50"">"
Response.Write "执行时间：" & CStr(FormatNumber((EndTime-StartTime)*1000, 2)) & " 毫秒<br>"
Response.Write "数据整理中，3秒后继续......3秒后如果还没反应请点击 <a href='Admin_CollectionRun.asp?ChannelID="& Application("Collection_"& CacheName)(41, 0) &"&SuccNum="& SuccNum &"&FailNum="& FailNum &"&ListNum="& ListNum &"&PageNum="& NextPageNum &"&ListURL="& EL_Common.ServerHTMLEncode(NextPageURL) &"&Collection="& CollectionID &"&CollectionType="& CollectionType &"'><font color=red>这里</font></a> 继续<br>"
Response.Write "<meta http-equiv=""refresh"" content=""3;url=Admin_CollectionRun.asp?ChannelID="& Application("Collection_"& CacheName)(41, 0) &"&SuccNum="& SuccNum &"&FailNum="& FailNum &"&ListNum="& ListNum &"&PageNum="& NextPageNum &"&ListURL="& EL_Common.ServerHTMLEncode(NextPageURL) &"&Collection="& CollectionID &"&CollectionType="& CollectionType &""">"
Response.Write "</td></tr>"
Response.Write "</table><br>"
%>
<%
Sub ShowItem(ByVal ListNo, ByVal Title, ByVal Keyword, ByVal Author, ByVal Copyfrom, ByVal UpdateTime, ByVal Content, ByVal TargetURL, ByVal PageInfo, ByVal PictrueNum, ByVal RE, ByVal EMsg)
%>
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
<tr>
<td class="td_ItemName"><a name="The_<%=ListNo%>"></a>No.<span class="redText"><%=ListNo%></span></td>
</tr>
<tr>
<td class="td_50">
<% If RE = True Then %>
<span class="redText">采集信息内容时发生错误，操作失败。</span>
<script>document.getElementById("fail").innerText = parseInt(document.getElementById("fail").innerText)+1;</script>
<%=EMsg%>
<% Else %>
信息标题：<span class="redText"><%=Out(Title)%></span><br>
关 键 字：<%=Out(Keyword)%><br>
信息作者：<%=Out(Author)%><br>
信息来源：<%=Out(Copyfrom)%><br>
更新时间：<%=Out(UpdateTime)%><br>
采集页面：<%=TargetURL%><br>
其他信息：分页[ <span class="BlueText"><%=PageInfo%></span> 页]，图片[ <span class="BlueText"><%=PictrueNum%></span> 张]<br>
正文预览：[<a id="A_<%=ListNo%>" href="javascript:Show(<%=ListNo%>)">点击预览</a>]
<script>document.getElementById("succ").innerText = parseInt(document.getElementById("succ").innerText)+1;</script>
<div id="Content_<%=ListNo%>" style="margin:1px; border:1px solid #BABABA; display:none;">
<%=Content%>
<div style="background:#DDDDDD; height:20px; padding-top:5px; text-align:center;"><a href="javascript:Show(<%=ListNo%>)">关闭预览</a></div>
</div>
<% End If %>
<script>document.getElementById("list").innerText = parseInt(document.getElementById("list").innerText)+1;</script>
</td>
</tr>
</table>
<br>
<script>//scrollBy(0,document.body.scrollHeight)</script>
<%
Response.Flush()
End Sub
Sub CollectionCompleted()
Application.Contents.Remove("Collection_"& CacheName)
Application.Contents.Remove("Fliter_"& CacheName)
%>
<link href='Admin_Style.css' type='text/css' rel='stylesheet'>
<br><br>
<table width="500" border="0" align="center" cellpadding="0" cellspacing="1" class="Border">
<tr>
<td align="center" class="td_ItemName"><strong>信息采集完成</strong></td>
</tr>
<tr>
<td align="center" class="td_50" style="height:150px;"> 总共采集： <span class="BlueText"><%=ListNum%></span> 条 采集成功：<span class="GreenText"><%=SuccNum%></span> 条 采集失败： <span class="redText"><%=FailNum%></span> 条 <br>
<br>
3秒后系统无自动返回，请点击<a href="Admin_Collection.asp"><span class="redText">这里返回</span></a></td>
</tr>
</table>
<%
Response.Write "<meta http-equiv=""refresh"" content=""3;url=Admin_Collection.asp"">"
Call ApplicationTerminate()
End Sub
%>
<% Set EL_Collection = Nothing %>
<%
Sub Fliter()
If IsArray(AppFliter) = False Then Exit Sub
Dim L, i, bPos, ePos, s
L = UBound(AppFliter, 2)
For i = 0 To L
If AppFliter(3, i) = 0 Then '标题过滤
If AppFliter(4, i) = 0 Then '简单过滤
Title = Replace(Title, AppFliter(5, i), AppFliter(7, i))
Else
bPos = InstrB(1, Title, AppFliter(5, i), 0)
If bPos > 0 Then
ePos = InstrB(bPos, Title, AppFliter(6, i), 0)
If ePos > 0 And ePos > bPos Then
ePos = ePos + LenB(AppFliter(6, i))
s = MidB(Title, bPos, ePos - bPos)
Title = Replace(Title, s, AppFliter(7, i))
End If
End If
End If
Else
If AppFliter(4, i) = 0 Then
Content = Replace(Content, AppFliter(5, i), AppFliter(7, i))
Else
bPos = InstrB(1, Content, AppFliter(5, i), 0)
If bPos > 0 Then
ePos = InstrB(bPos, Content, AppFliter(6, i), 0)
If ePos > 0 And ePos > bPos Then
ePos = ePos + LenB(AppFliter(6, i))
s = MidB(Content, bPos, ePos - bPos)
Content = Replace(Content, s, AppFliter(7, i))
End If
End If
End If
End If
Next
End Sub
Sub InputData(ByVal ChannelID, ByVal ClassID, ByVal Title, ByVal Keyword, ByVal Author, ByVal Copyfrom, ByVal UpdateTime, ByVal Content, ByVal Uploadfiles, ByVal Hits, ByVal OnTop, ByVal Commended, ByVal Passed, ByVal SkinID, ByVal TemplateID, ByVal DefineField)
Dim DefaultPictrue
If Uploadfiles <> "" Then
DefaultPictrue = Split(Uploadfiles, "|")(0)
Else
DefaultPictrue = ""
End If
With ArticleCmd
.Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
.Parameters.Append .CreateParameter("@UpdateType", 3, 1, 4, 0)
.Parameters.Append .CreateParameter("@ArticleID", 3, 2, 4)
.Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, ChannelID)
.Parameters.Append .CreateParameter("@ClassID", 3, 1, 4, ClassID)
.Parameters.Append .CreateParameter("@Title", 200, 1, 255, Title)
.Parameters.Append .CreateParameter("@Keywords", 200, 1, 255, Keyword)
.Parameters.Append .CreateParameter("@Author", 200, 1, 50, Author)
.Parameters.Append .CreateParameter("@Copyfrom", 200, 1, 50, Copyfrom)
.Parameters.Append .CreateParameter("@Content", 203, 1, EL_Common.LenParameter(Content), Content)
.Parameters.Append .CreateParameter("@DefaultPictrue", 200, 1, 255, DefaultPictrue)
.Parameters.Append .CreateParameter("@Uploadfiles", 203, 1, EL_Common.LenParameter(Uploadfiles), Uploadfiles)
.Parameters.Append .CreateParameter("@Hits", 3, 1, 4, Hits)
.Parameters.Append .CreateParameter("@OnTop", 11, 1, 1, OnTop)
.Parameters.Append .CreateParameter("@Commended", 11, 1, 1, Commended)
.Parameters.Append .CreateParameter("@Passed", 11, 1, 1, Passed)
.Parameters.Append .CreateParameter("@UpdateTime", 135, 1, 8, UpdateTime)
.Parameters.Append .CreateParameter("@SkinID", 3, 1, 4, SkinID)
.Parameters.Append .CreateParameter("@TemplateID", 3, 1, 4, TemplateID)
.Parameters.Append .CreateParameter("@Inputer", 200, 1, 50, EL_Admin.AdminName)
.Parameters.Append .CreateParameter("@Editor", 200, 1, 50, EL_Admin.AdminName)
.Parameters.Append .CreateParameter("@DefineField", 200, 1, 4000, DefineField)
.Parameters.Append .CreateParameter("@ClassName", 200, 2, 50)
.Execute()
End With
Call EL_Common.DeleteCmdParameters(ArticleCmd, 23)
End Sub
Function FliterContent(ByVal Content, ByVal ArrFliter)
Dim TempContent
TempContent = Content
If EL_Common.FoundInArray(ArrFliter, 1) Then TempContent = EL_Collection.FliterScript(TempContent, "Iframe", 1)
If EL_Common.FoundInArray(ArrFliter, 2) Then TempContent = EL_Collection.FliterScript(TempContent, "Object", 2)
If EL_Common.FoundInArray(ArrFliter, 3) Then TempContent = EL_Collection.FliterScript(TempContent, "Script", 2)
If EL_Common.FoundInArray(ArrFliter, 18) Then TempContent = EL_Collection.FliterScript(TempContent, "Event", 5)
If EL_Common.FoundInArray(ArrFliter, 4) Then TempContent = EL_Collection.FliterScript(TempContent, "Div", 3)
If EL_Common.FoundInArray(ArrFliter, 5) Then
TempContent = EL_Collection.FliterScript(TempContent, "Style", 4)
TempContent = EL_Collection.FliterScript(TempContent, "Class", 4)
End If
If EL_Common.FoundInArray(ArrFliter, 6) Then TempContent = EL_Collection.FliterScript(TempContent, "Table", 3)
If EL_Common.FoundInArray(ArrFliter, 7) Then TempContent = EL_Collection.FliterScript(TempContent, "Tr", 3)
If EL_Common.FoundInArray(ArrFliter, 8) Then TempContent = EL_Collection.FliterScript(TempContent, "Td", 3)
If EL_Common.FoundInArray(ArrFliter, 9) Then TempContent = EL_Collection.FliterScript(TempContent, "Span", 3)
If EL_Common.FoundInArray(ArrFliter, 10) Then TempContent = EL_Collection.FliterScript(TempContent, "Img", 3)
If EL_Common.FoundInArray(ArrFliter, 11) Then TempContent = EL_Collection.FliterScript(TempContent, "Font", 3)
If EL_Common.FoundInArray(ArrFliter, 12) Then TempContent = EL_Collection.FliterScript(TempContent, "A", 3)
If EL_Common.FoundInArray(ArrFliter, 13) Then TempContent = EL_Common.RemoveHTML(TempContent)
FliterContent = TempContent
End Function
Sub CheckError(ByVal CheckStr, RE, EM, ES)
If CheckStr = "$RequestError" Or Trim(CheckStr) = "" Then
EM = EM &"<br><li>"& ES &"</li>"
RE = True
Else
RE = False
End If
End Sub
Function Out(ByVal s)
If ISNULL(s) Then
Out = ""
Else
Out = EL_Common.ServerHTMLEncode(s)
End If
End Function
%>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -