📄 admin_collectionfast.asp
字号:
if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
NewsTypeCode=CGet.ReplaceTrim(CGet.GetHttpPage(TypeNewsUrl,Encoding))
PicUrls=CGet.GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
if PicUrls="$False$" Then
ErrMsg=ErrMsg & "<br><li>在获取"&NewsUrl&"图片地址时发生错误。</li>"
else
PicUrls=Trim(CGet.FormatRemoteUrl(PicUrls,TypeNewsUrl))
if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定地址
end if
Else
PicUrls=TypeNewsUrl
end if
if PicUrls<>"$False$" Then
PicUrlsTemp=PicUrls
IF SaveFiles=1 then
PicUrls=CGet.SaveFile(ModuleID,PicUrls,SaveFileUrl)
if PicUrls=False then
PicUrls=PicUrlsTemp
Response.Write " ----" & PicUrls & " 保存失败<br>"
Else
Response.Write " " & CGet.GetItemConfig("CjName",ModuleID) & I &"--" & PicUrls & " 保存成功<br>"
End if
Response.Flush()
End IF
if PicUrls<>False then
If arr_ii=0 and Arr_ii_2=0 then
PicUrls_i="图片地址1|" & PicUrls
i=i+1
Else
PicUrls_i= PicUrls_i & "@@@图片地址" & i & "|" & PicUrls
i=i+1
End if
PicUrls=PicUrls_i
End if
end if
End If
Next
End If
Next
PicUrls=PicUrls_i
Call SaveArticle
Else
Call Coll_ListType_2
End if
Else
Call Coll_ListType_2
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "2级分类列表源码时发生错误。</li>"
End If
End if
If NewsPaingType=0 Then
If Downlist_s="" or Downlist_o="" or DownUrl_s="" or DownUrl_o="" then'图片下载
FoundErr=True
ErrMsg=ErrMsg & "<br><li>图片地址设置不能为空</li>"
Else
DownUrls=CGet.GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
If DownUrls<>"$False$" then
DownUrls=CGet.GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
IF DownUrls<>"$False$" then
DownUrls=Trim(CGet.FormatRemoteUrl(DownUrls,NewsUrl))
DownUrlsTemp=DownUrls
IF SaveFiles=1 then
DownUrls=CGet.SaveFile(ModuleID,DownUrls,SaveFileUrl)
if DownUrls=False then
DownUrls=DownUrlsTemp
Response.Write " ----" & DownUrls & " 保存失败<br>"
Else
Response.Write " 图片" & DownUrls & " 保存成功<br>"
End if
Response.Flush()
End IF
PicUrls=DownUrls
PicUrls= "图片地址1|" & PicUrls
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "图片链接时发生错误。</li>"
End if
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "图片列表源码时发生错误。</li>"
End if
End if
End if
End If
If ModuleID=4 And Founderr<>True Then '影视
If Downlist_s="" Or Downlist_o="" Or Downurl_s="" Or Downurl_o="" Then'下载地址设置
Founderr=True
Errmsg=Errmsg & "<br><li>影视地址设置不能为空</li>"
Else
Downurls=CGet.Getbody(newscode,downlist_s,downlist_o,False,False)
If Downurls<>"$False$" Then
If Linkurlyn=1 Then
Downurls=CGet.Getarray(downurls,downurl_s,downurl_o,False,False)
Else
Downurls=CGet.Getbody(downurls,downurl_s,downurl_o,False,False)
End If
If Downurls<>"$False$" Then
If Linkurlyn=1 Then
I=1
Typeurlarray=split(downurls,"$Array$")
For Arr_ii=0 To Ubound(typeurlarray)
Downurls=Trim(CGet.formatremoteurl(typeurlarray(arr_ii),newsurl))
DownurlsTemp=Downurls
If Savefiles=1 Then
Downurls=CGet.savefile(ModuleID,Downurls,SaveFileUrl)
DownurlsTemp=Downurls
If Downurls=False Then
Downurls=DownurlsTemp
Response.write " ----" & Downurls & " 保存失败<br>"
Else
Response.write " " & CGet.Getitemconfig("cjName",ModuleID) & I &"--" & Downurls & " 保存成功<br>"
End If
Response.flush()
End If
If Arr_ii=0 Then
Downurls_i="影视地址1|" & Downurls
I=i+1
Else
Downurls_i= Downurls_i & "@@@影视地址" & I & "|" & Downurls
I=i+1
End If
Next
Downurls=downurls_i
Else
Downurls=Trim(CGet.formatremoteurl(downurls,newsurl))
If Savefiles=1 and Downnewtype<>1 Then
DownurlsTemp=Downurls
Downurls=CGet.savefile(ModuleID,Downurls,SaveFileUrl)
DownurlsTemp=Downurls
If Downurls=False Then
Downurls=DownurlsTemp
Response.write " ----" & Downurls & " 保存失败<br>"
Else
Response.write " " & CGet.Getitemconfig("cjName",ModuleID) & I &"--" & Downurls & " 保存成功<br>"
End If
Response.flush()
End If
Downurls="影视地址1|" & Downurls
End If
Else
Founderr=True
Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "影视地址链接源码时发生错误。</li>"
End If
Else
Founderr=True
Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "影视地址列表源码时发生错误。</li>"
End If
End If
If Downnewtype=1 Then'新窗口打开下载连接
If Downnewlist_s<>"" Or Downnewlist_o<>"" Or Downnewurl_s<>"" Or Downnewurl_o<>"" Then
Downurls=replace(downurls,"影视地址1|","")
Downurls=CGet.replaceTrim(CGet.GetHttpPage(downurls,Encoding))
Downurls=CGet.Getbody(downurls,downnewlist_s,downnewlist_o,False,False)
If Downurls<>"$False$" Then
Downurls=CGet.Getarray(downurls,downnewurl_s,downnewurl_o,False,False)
If Downurls<>"$False$" Then
I=1
Typeurlarray=split(downurls,"$Array$")
For Arr_ii=0 To Ubound(typeurlarray)
Downurls=Trim(CGet.formatremoteurl(typeurlarray(arr_ii),newsurl))
DownurlsTemp=Downurls
If Savefiles=1 Then
Downurls=CGet.savefile(ModuleID,Downurls,SaveFileUrl)
DownurlsTemp=Downurls
If Downurls=False Then
Downurls=DownurlsTemp
Response.write " ----" & Downurls & " 保存失败<br>"
Else
Response.write " " & CGet.Getitemconfig("cjName",ModuleID) & I &"--" & Downurls & " 保存成功<br>"
End If
Response.flush()
End If
If Arr_ii=0 Then
Downurls_i="影视地址1|" & Downurls
I=i+1
Else
Downurls_i= Downurls_i & "@@@影视地址" & I & "|" & Downurls
I=i+1
End If
Next
Downurls=downurls_i
Else
'Founderr=True
Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)下载地址列表源码时发生错误</li>"
End If
Else
'Founderr=True
Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)下载地址列表源码时发生错误</li>"
End If
Else
Founderr=True
Errmsg=Errmsg & "<br><li>影视地址设置不能为空</li>"
End If
End If
End if
If FoundErr<>True Then
If DateType=0 Then
UpDateTime=Now()
Else
If DateType=1 Then
UpDateTime=CGet.GetBody(NewsCode,DsString,DoString,False,False)
UpDateTime=FpHtmlEncode(UpDateTime)
UpDateTime=Trim(Replace(UpDateTime," "," "))
If IsDate(UpDateTime)=True Then
UpDateTime=CDate(UpDateTime)
Else
UpDateTime=Now()
End If
End If
End If
If AuthorType=1 Then
Author=CGet.GetBody(NewsCode,AsString,AoString,False,False)
ElseIf AuthorType=2 Then
Author=AuthorStr
Else
Author="佚名"
End If
Author=FpHtmlEncode(Author)
If Author="" or Author="$False$" then
Author="佚名"
Else
If Len(Author)>255 then
Author=Left(Author,255)
End If
End If
If CopyFromType=1 Then
CopyFrom=CGet.GetBody(NewsCode,FsString,FoString,False,False)
ElseIf CopyFromType=2 Then
CopyFrom=CopyFromStr
Else
CopyFrom="不详"
End If
CopyFrom=FpHtmlEncode(CopyFrom)
If CopyFrom="" or CopyFrom="$False$" Then
CopyFrom="不详"
Else
If Len(CopyFrom)>255 Then
CopyFrom=Left(CopyFrom,255)
End If
End If
If KeyType=0 Then
Key=Title
Key=CreateKeyWord(Key,2)
ElseIf KeyType=1 Then
Key=CGet.GetBody(NewsCode,KsString,KoString,False,False)
Key=Replace(Key,",","|")
Key=Replace(Key," ","|")
Key=FpHtmlEncode(Key)
'Key=CreateKeyWord(Key,2)
ElseIf KeyType=2 Then
Key=KeyStr
Key=FpHtmlEncode(Key)
If Len(Key)>253 Then
Key= Left(Key,253)
Else
Key=Key
End If
End If
If Key="" or Key="$False$" Then
Key=KeyStr
End If
If UploadFiles<>"" Then
If Instr(UploadFiles,"|")>0 Then
Arr_Images=Split(UploadFiles,"|")
ImagesNum=Ubound(Arr_Images)+1
DefaultPicUrl=Arr_Images(0)
Else
ImagesNum=1
DefaultPicUrl=UploadFiles
End If
If DefaultPicYn=False then
DefaultPicUrl=""
End If
If IncludePicYn=True Then
IncludePic=-1
Else
IncludePic=0
End If
If SaveFiles<>True Then
UploadFiles=""
End If
Else
ImagesNum=0
DefaultPicUrl=""
IncludePic=0
End If
ImagesNumAll=ImagesNumAll+ImagesNum
End If
if ModuleID =1 then
set rs = Conn_C.execute("select top 1 Dir from ModuleInfo where ID="& ModuleID)
SavefilePath=replace(rs("dir"),"{$DefaultDir}",Cl.WebDir&Cl.Upload_Setting(0)&Cl.ChannelUpLoadSetting(1))
SavefilePath=Cl.ReplaceDir(SavefilePath)
If Savefiles=1 Then
Content=CGet.replacesaveremotefile(content,"/",SavefilePath & Savefileurl,True,newsurl,ModuleID)'远程图片
Content=CGet.resaveremotefile(content,newsurl,SavefilePath & Savefileurl,True,ModuleID)'远程文件
Else
Content=CGet.replacesaveremotefile(content,"/",SavefilePath,False,newsurl,ModuleID)'远程图片
Content=CGet.resaveremotefile(content,newsurl,SavefilePath,False,ModuleID)'远程文件
End if
rs.close:set rs=nothing
End if
'--
If FoundErr<>True Then
If His_Repeat<>True Then Call SaveArticle
SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,InfoID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',True)"
Conn_C.Execute(SqlItem)
Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & ChannelDir & "/")
NewsSuccesNum=NewsSuccesNum+1
ErrMsg=ErrMsg & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0""><tr class=""title""><td align=""left""> No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font></td></tr><tr class=""tdbg""><td>"
ErrMsg=ErrMsg & CGet.GetItemConfig("CjName",ModuleID) &"标题："
ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
ErrMsg=ErrMsg & "更新时间：" & UpDateTime & "<br>"
If ModuleID=1 then ErrMsg=ErrMsg & "新闻标题：" : ErrMsg=ErrMsg & "新闻作者：" & Author & "<br>" : ErrMsg=ErrMsg & "新闻来源：" & CopyFrom & "<br>"
ErrMsg=ErrMsg & "采集页面：<a href=" & NewsUrl & " target=_blank>" & NewsUrl & "</a><br>"
if x_tp =1 then ErrMsg=ErrMsg & "缩 略 图：<a href=" & picpath & " target=_blank>" & picpath & "</a><br>"
ErrMsg=ErrMsg & "正文预览："
If ContentPreview = "Yes" Then
ErrMsg=ErrMsg & "<br><table>" & Content &"</table>"
Else
ErrMsg=ErrMsg & "您没有启用正文预览功能"
End If
ErrMsg=ErrMsg & "<br><br>关 键 字：" & Key & "</td></tr></table>"
Else
NewsFalseNum=NewsFalseNum+1
If His_Repeat=True Then
ErrMsg=ErrMsg & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0""><tr class=""title""><td align=""left""> No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font></td></tr><tr class=""tdbg""><td>"
ErrMsg=ErrMsg & "目标"& CGet.GetItemConfig("CjName",ModuleID) &"：<font color=red>"
If His_Result=True Then
ErrMsg=ErrMsg & His_Title
Else
ErrMsg=ErrMsg & NewsUrl
End If
ErrMsg=ErrMsg & "</font> 的记录已存在，不给予采集。<br>"
ErrMsg=ErrMsg & "采集时间：" & His_CollecDate & "<br>"
ErrMsg=ErrMsg & ""& CGet.GetItemConfig("CjName",ModuleID) &"来源：<a href='" & NewsUrl & "' target=_blank>"&NewsUrl&"</a><br>"
ErrMsg=ErrMsg & "采集结果："
If His_Result=False Then
ErrMsg=ErrMsg & "失败"
ErrMsg=ErrMsg & "<br>失败原因：" & Title
Else
ErrMsg=ErrMsg & "成功"
End If
ErrMsg=ErrMsg & "<br>提示信息：如想再次采集，请先将该新闻的历史记录<font color=red>删除</font></td></tr></table>"
End If
If His_Repeat=False Then
SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',False)"
Conn_C.Execute(SqlItem)
End If
End If
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" class=""Border"" cellspacing=""1"">"
Response.Write " <tr class='tdbg'>"
Response.Write " <td height=""22"" colspan=""2"" align=""left"">"
Response.Write ErrMsg
Response.Write " </td>"
Response.Write " </tr><br>"
Response.Write "</table>"
Response.Flush()'刷新
Next
If ListEnd<>true then
if Collecdate<>"" Then
Collecdate=Day(now())
response.write("<script>location.href='Admin_Timing.asp?action=GoTiming&Collecdate="& Day(now()) &"';</script>")'到页面
Else
response.write("<script>location.href='Admin_CollectionFast.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum +1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& 0 &"&Itemok="& Itemok &"&Itemon="& Itemon &"&Collecdate="& Collecdate &"';</script>")'完成
End if
End if
Else
If FoundErr_1=True Then
response.write("<script>location.href='Admin_CollectionFast.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum +1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& 0 &"&Itemok="& Itemok &"&Itemon="& Itemon &"&Collecdate="& Collecdate &"';</script>")'完成
FoundErr_1=False
End If
Call ShowMsg(ErrMsg)
End If
End Sub
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -