📄 sk_collectionfast.asp
字号:
DownUrls=Skcj.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(Skcj.FormatRemoteUrl(TypeUrlArray(Arr_ii),NewsUrl))
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(Skcj.FormatRemoteUrl(DownUrls,NewsUrl))
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=Skcj.ReplaceTrim(skcj.GetHttpPage(DownUrls,selEncoding))
DownUrls=Skcj.GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
If DownUrls<>"$False$" then
DownUrls=Skcj.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(Skcj.FormatRemoteUrl(TypeUrlArray(Arr_ii),NewsUrl))
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
If ZdType_001=0 then'软件大小设置
DownSize=""
Else
If Zds_001="0" and Zdo_001<>"" then
DownSize=Zdo_001
Else
DownSize=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_001,Zdo_001,False,False))
End If
End If
If ZdType_002=0 then'软件语言设置
DownYY=""
Else
If Zds_002="0" and Zdo_002<>"" then
DownYY=Zdo_002
Else
DownYY=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_002,Zdo_002,False,False))
End If
End If
If ZdType_003=0 then'授权方式设置
DownSQ=""
Else
If Zds_003="0" and Zdo_003<>"" then
DownSQ=Zdo_003
Else
DownSQ=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_003,Zdo_003,False,False))
End If
End If
If ZdType_004=0 then'运行环境设置
DownPT=""
Else
If Zds_004="0" and Zdo_004<>"" then
DownPT=Zdo_004
Else
DownPT=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_004,Zdo_004,False,False))
End If
End If
If ZdType_005=0 then'演示地址设置
YSDZ=""
Else
If Zds_005="0" and Zdo_005<>"" then
YSDZ=Zdo_005
Else
YSDZ=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_005,Zdo_005,False,False))
End If
End If
If ZdType_006=0 then'注册地址设置
ZCDZ=""
Else
If Zds_006="0" and Zdo_006<>"" then
ZCDZ=Zdo_006
Else
ZCDZ=FpHtmlEncode(Skcj.GetBody(NewsCode,Zds_006,Zdo_006,False,False))
End If
End If
If ZdType_007=0 then'软件图片设置
PhotoUrl=""
Else
If Zds_007="0" and Zdo_007<>"" then
PhotoUrl=Zdo_007
Else
PhotoUrl=Skcj.GetBody(NewsCode,Zds_007,Zdo_007,False,False)
PhotoUrl=Trim(Skcj.FormatRemoteUrl(PhotoUrl,NewsUrl))
End If
End If
End if
IF Colleclx=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=Skcj.GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
If DownUrls<>"$False$" then
DownUrls=Skcj.GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
IF DownUrls<>"$False$" then
DownUrls=Trim(Skcj.FormatRemoteUrl(DownUrls,NewsUrl))
IF SaveFiles=1 then
DownUrls=Skcj.Sk_SaveFile(Colleclx,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=Skcj.ReplaceTrim(skcj.GetHttpPage(DownUrls,selEncoding))
DownUrls=Skcj.GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
If DownUrls<>"$False$" then
DownUrls=Skcj.GetBody(DownUrls,DownNewUrl_s,DownNewUrl_o,False,False)
IF DownUrls<>"$False$" then
DownUrls=Trim(Skcj.FormatRemoteUrl(DownUrls,NewsUrl))
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=Skcj.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=Skcj.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=Skcj.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=Skcj.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 Colleclx =1 then
set rs = ConnItem.execute("select top 1 Dir from SK_cj where ID="& Colleclx)
IF SaveFiles=1 then
Content=Skcj.ReplaceSaveRemoteFile(Content,"/",rs("Dir") & SaveFileUrl,True,NewsUrl)'远程图片
Content=SKcj.ReSaveRemoteFile(Content,NewsUrl,rs("Dir") & SaveFileUrl,True)'远程文件
Else
Content=Skcj.ReplaceSaveRemoteFile(Content,"/",rs("Dir"),False,NewsUrl)'远程图片
Content=Skcj.ReSaveRemoteFile(Content,NewsUrl,rs("Dir"),False)'远程文件
End if
rs.close
set rs=nothing
End if
'--
If FoundErr<>True Then
If His_Repeat<>True Then
Call sk.SaveArticle
End if
If CollecTest=False Then
SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,ArticleID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',True)"
ConnItem.Execute(SqlItem)
Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & strChannelDir & "/")
End If
NewsSuccesNum=NewsSuccesNum+1
ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
ErrMsg=ErrMsg & Skcj.GetItemConfig("CjName",Colleclx) &"标题："
ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
ErrMsg=ErrMsg & "更新时间：" & UpDateTime & "<br>"
If Colleclx=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 Content_View=True Then
ErrMsg=ErrMsg & "<br>" & Content
Else
ErrMsg=ErrMsg & "您没有启用正文预览功能"
End If
ErrMsg=ErrMsg & "<br><br>关 键 字：" & Key & ""
Else
NewsFalseNum=NewsFalseNum+1
If His_Repeat=True Then
ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
ErrMsg=ErrMsg & "目标"& Skcj.GetItemConfig("CjName",Colleclx) &"：<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 & ""& Skcj.GetItemConfig("CjName",Colleclx) &"来源：<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><br>"
End If
If CollecTest=False And 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)"
ConnItem.Execute(SqlItem)
End If
End If
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" class=""tableBorder"" 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='sk_Timing.asp?action=GoTiming&Collecdate="& Day(now()) &"';</script>")'到页面
Else
response.write("<script>location.href='Sk_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='Sk_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 Sk.ShowMsg(ErrMsg)
End If
End Sub
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -