?? sk_collectionfast.asp
字號:
Else
ListEnd=True
End if
End If
If ListNum>CollecListNum And CollecListNum<>0 Then
ListEnd=True
End if
End If
If ItemEnd=True Then
ErrMsg= "<br>采集任務全部完成"
ErrMsg=ErrMsg & "<br>成功采集： " & NewsSuccesNum & " 條,失敗： " & NewsFalseNum & " 條,圖片：" & ImagesNumAll & " 張"
Call DelCache()
ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""1;url="& Skcj.GetItemConfig("FileName",Colleclx) &""">"
Else
If ListEnd=True Then
If Itemon<>"" then Itemok= "yes"'全選采集
If Instr(Itemon,",")>0 or Itemon<>"" 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=0&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& 0 &"&Itemok="& Itemok &"&Itemon="& Itemon &"&Collecdate="& Collecdate &"';</script>")'完成
Response.end
End if
End if
ItemNum=ItemNum+1
ListNum=1
ErrMsg="<br>" & ItemName & " 項目所有列表采集完成，正在整理數據請稍后..."
ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""1;url="& Skcj.GetItemConfig("FileName",Colleclx) &""">"
End If
End If
SK.TopItem()'Top頂部
If ItemEnd=True Or ListEnd=True Then
If ItemEnd<>True Then
Sk.SetCache_His()
End If
Call WriteSucced(ErrMsg)
Else
FoundErr=False
ErrMsg=""
Call StartCollection()'開始采集
SK.FootItem2()
End If
End Sub
Sub StartCollection'開始采集
IF Colleclx <> 0 then
Set Rs = ConnItem.execute("Select top 1 Dir,MaxFileSize,FileExtName,Timeout from SK_Cj where ID="& Colleclx )
Else
Set Rs = ConnItem.execute("Select top 1 Dir,MaxFileSize,FileExtName,Timeout from SK_Cj where ID=1" )
End if
Skcj.CjTimeout=Rs("Timeout")
Skcj.DownExtName=Rs("FileExtName")
Skcj.MaxSize=Rs("MaxFileSize")
Rs.close : Set Rs=Nothing
If NewsSuccesNum >= CollecNewsNum And CollecNewsNum<>0 then
If Itemon="" then
if Collecdate<>"" then
response.write("<script>location.href='sk_Timing.asp?action=GoTiming&Collecdate="& Day(now()) &"';</script>")
Else
Response.Write "<br> 采集完成，正在整理數據請稍后..."
Response.Write "<meta http-equiv=""refresh"" content=""1;url="& Skcj.GetItemConfig("FileName",Colleclx) &""">"
End if
Else
response.write "<script>location.href='Sk_CollectionFast.asp?ItemID="& ItemID &"&ItemNum=1&ListNum=1&NewsSuccesNum=0&NewsFalseNum=0&ImagesNumAll=0&NewsNum_i=0&Itemon="& Itemon &"&Itemok=yes&Collecdate="& Collecdate &"';</script>"
End if
Response.end
End if
If FoundErr<>True then
ListCode=Skcj.ReplaceTrim(Skcj.GetHttpPage(ListUrl,selEncoding))
Sk.GetListPaing()
If ListCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取列表：" & ListUrl & "網頁源碼時發生錯誤！</li>"
Else
ListCode=Skcj.GetBody(ListCode,LsString,LoString,False,False)
If ListCode="$False$" Or ListCode="" Then
FoundErr=True
FoundErr_1=True
ErrMsg=ErrMsg & "<br><li>在截取：" & ListUrl & "的"& Skcj.GetItemConfig("CjName",Colleclx) &"列表時發生錯誤！</li>"
End If
End If
End If
If FoundErr<>True Then
NewsArrayCode=Skcj.GetArray(ListCode,HsString,HoString,False,False)
If NewsArrayCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & ""& Skcj.GetItemConfig("CjName",Colleclx) &"列表時發生錯誤！</li>"
Else
NewsArray=Split(NewsArrayCode,"$Array$")
For Arr_i=0 to Ubound(NewsArray)
If HttpUrlType=1 Then
NewsArray(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(Arr_i)))
Else
NewsArray(Arr_i)=Trim(FormatRemoteUrl(NewsArray(Arr_i),ListUrl))
End If
NewsArray(Arr_i)=CheckUrl(NewsArray(Arr_i))
Next
If CollecOrder=1 Then
For Arr_i=0 to Fix(Ubound(NewsArray)/2)
OrderTemp=NewsArray(Arr_i)
NewsArray(Arr_i)=NewsArray(Ubound(NewsArray)-Arr_i)
NewsArray(Ubound(NewsArray)-Arr_i)=OrderTemp
Next
End If
End If
End If
If FoundErr<>True Then
If x_tp=1 then
NewsimageCode=Skcj.GetArray(ListCode,imhstr,imostr,False,False)
If NewsimageCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & "小圖片列表時發生錯誤！</li>"
Else
Newsimage=Split(NewsimageCode,"$Array$")
For Arr_i=0 to Ubound(Newsimage)
If HttpUrlType=1 Then
Newsimage(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",Newsimage(Arr_i)))
Else
Newsimage(Arr_i)=Trim(Skcj.FormatRemoteUrl(Newsimage(Arr_i),ListUrl))
End If
if x_tpUrl<>"" then Newsimage(Arr_i)= x_tpUrl & Newsimage(Arr_i)
Newsimage(Arr_i)=CheckUrl(Newsimage(Arr_i))
Next
If CollecOrder=True Then
For Arr_i=0 to Fix(Ubound(Newsimage)/2)
OrderTemp=Newsimage(Arr_i)
Newsimage(Arr_i)=Newsimage(Ubound(Newsimage)-Arr_i)
Newsimage(Ubound(Newsimage)-Arr_i)=OrderTemp
Next
End If
End If
End If
End if
If FoundErr<>True Then
dim PicUrls_i
SK.TopItem2()
CollecNewsAll=0
For Arr_i=0 to Ubound(NewsArray)
'Arr_i=NewsNum_i
If CollecNewsAll>=CollecNewsNum And CollecNewsNum<>0 then Exit For'限條數
CollecNewsAll=CollecNewsAll+1
UploadFiles=""
DefaultPicUrl=""
IncludePic=0
ImagesNum=0
NewsCode=""
FoundErr=False
ErrMsg=""
His_Repeat=False
NewsUrl=NewsArray(Arr_i)
Title=""
PaingNum=1
If Response.IsClientConnected Then
Response.Flush
Else
Response.End
End If
If CollecTest=False Then
His_Repeat=SK.CheckRepeat(NewsUrl)
Else
His_Repeat=False
End If
If His_Repeat=True Then
FoundErr=True
End If
If FoundErr<>True then
If x_tp=1 then
'On Error Resume Next
picpath=Newsimage(arr_i)
iF SaveFiles=1 then picpath=Skcj.Sk_SaveFile(Colleclx,picpath)
End if
End if
If FoundErr<>True Then
NewsCode=Skcj.ReplaceTrim(skcj.GetHttpPage(NewsUrl,selEncoding))
If NewsCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br>在獲取：" & NewsUrl & "網頁源碼時發生錯誤！"
Title="獲取網頁源碼失敗"
End If
End If
If FoundErr<>True Then
Title=Skcj.GetBody(NewsCode,TsString,ToString,False,False)
If Title="$False$" or Title="" then
FoundErr=True
ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的"& Skcj.GetItemConfig("CjName",Colleclx) &"標題時發生錯誤"
Title="<br>標題分析錯誤"
End If
If FoundErr<>True Then
if CsString<>"0" or CoString<>"0" then
Content=Skcj.GetBody(NewsCode,CsString,CoString,False,False)
else
Content=""
end if
If Content="$False$" Then
'FoundErr=True
'ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的"& Skcj.GetItemConfig("CjName",Colleclx) &"正文時發生錯誤"
Title=Title & "<br>正文分析錯誤"
End If
End If
If FoundErr<>True Then
If NewsPaingType=1 Then
NewsPaingNext=Skcj.GetBody(NewsCode,NPsString,NPoString,False,False)
If NewsPaingNext<>"$False$" Then
NewsPaingNext_Code=Skcj.GetArray(NewsPaingNext,NewsUrlPaing_s,NewsUrlPaing_o,False,False)
TypeArray_Url=Split( NewsPaingNext_Code,"$Array$")
if Ubound(TypeArray_Url)<>0 Then
For i=0 to Ubound(TypeArray_Url)
Call Sk.ShowMsg_1("分頁采集中... 當前采集第"&I+1&"頁<br>")
Response.Flush()
TypeNews_Url=Trim(Skcj.FormatRemoteUrl(TypeArray_Url(i),NewsUrl))
NewsPaingNextCode=Skcj.ReplaceTrim(skcj.GetHttpPage(TypeNews_Url,selEncoding))
'---------------------------圖片分頁--------------------------------------------
IF Colleclx=2 Then
PicUrls=Skcj.GetBody(NewsPaingNextCode,photourls,photourlo,False,False)
PicUrls=Trim(Skcj.FormatRemoteUrl(PicUrls,NewsUrl))
IF SaveFiles=1 then
PicUrls=Skcj.Sk_SaveFile(Colleclx,PicUrls)
If PicUrls=False then
Response.Write " ----" & PicUrls & " 保存失敗<br>"
Else
Response.Write " " & Skcj.GetItemConfig("CjName",Colleclx) & I &"--" & PicUrls & " 保存成功<br>"
End if
Response.Flush()
End IF
if PicUrls<>False then
If i=0 then
PicUrls_i="圖片1|" & PicUrls
Else
PicUrls_i= PicUrls_i & "|||圖片" & i & "|" & PicUrls
End if
End if
PicUrls=PicUrls_i
End if
'---------------------------圖片分頁------------------------------------------------
ContentTemp=Skcj.GetBody(NewsPaingNextCode,CsString,CoString,False,False)
If ContentTemp<>"$False$" then Content=Content & "[NextPage]" & ContentTemp
Next
End if
End If
End If
'過濾
SK.FilterScript()
SK.GetFilters
SK.Filters
Title=FpHtmlEnCode(Title)
Content=Ubbcode(Content)
Content=Skcj.ItemReplaceStr(Content,strReplace)'內容替換
End If
End If
If Colleclx=2 And FoundErr<>True then '圖片下載
'--------------------------------深度3采集-------------------------------------
IF NewsPaingType=2 Then
i=1
ListTypeCode=Skcj.GetBody(NewsCode,PhotoType_s,PhotoType_o,False,False)
If ListTypeCode<>"$False$" Then
ListTypeUrlCode=Skcj.GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
If Phototypefy_s<>"0" AND Phototypefy_o<>"0" AND Phototypefyurl_s<>"0" AND Phototypefyurl_o<>"0" Then
ListTypeCode_2=Skcj.GetBody(NewsCode,Phototypefy_s,Phototypefy_o,False,False)
If ListTypeCode_2<>"$False$" Then
ListTypeUrlCode_2=Skcj.GetArray(ListTypeCode_2,Phototypefyurl_s,Phototypefyurl_o,False,False)
TypeUrlArray_2=Split(ListTypeUrlCode_2,"$Array$")
For Arr_ii_2=0 to Ubound(TypeUrlArray_2)
TypeNewsUrl=Trim(Skcj.FormatRemoteUrl(TypeUrlArray_2(Arr_ii_2),NewsUrl))
NewsTypeCode=Skcj.ReplaceTrim(skcj.GetHttpPage(TypeNewsUrl,selEncoding))
ListTypeCode=Skcj.GetBody(NewsTypeCode,PhotoType_s,PhotoType_o,False,False)
If ListTypeCode<>"$False$" Then
ListTypeUrlCode=Skcj.GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
TypeUrlArray=Split(ListTypeUrlCode,"$Array$")
For Arr_ii=0 to Ubound(TypeUrlArray)
TypeNewsUrl=Trim(Skcj.FormatRemoteUrl(TypeUrlArray(Arr_ii),NewsUrl))
If TypeNewsUrl<>"$False$" Then
if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
NewsTypeCode=Skcj.ReplaceTrim(skcj.GetHttpPage(TypeNewsUrl,selEncoding))
PicUrls=Skcj.GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
PicUrls=Trim(Skcj.FormatRemoteUrl(PicUrls,TypeNewsUrl))
if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定地址
Else
PicUrls=TypeNewsUrl
end if
IF SaveFiles=1 then
PicUrls=Skcj.Sk_SaveFile(Colleclx,PicUrls)
if PicUrls=False then
Response.Write " ----" & PicUrls & " 保存失敗<br>"
Else
Response.Write " " & Skcj.GetItemConfig("CjName",Colleclx) & 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
Next
End If
Next
PicUrls=PicUrls_i
Call sk.SaveArticle
Else
Call sk.Coll_ListType_2
End if
Else
Call sk.Coll_ListType_2
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取:" & NewsUrl & "2級分類列表源碼時發生錯誤。</li>"
End If
End if
'-----------------------------深度3采集----------------------------------------
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=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)
if DownUrls=False then
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 Colleclx=3 And FoundErr<>True then '下載
dim DownUrls_i
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
IF LinkUrlYn=1 then
DownUrls=Skcj.GetArray(DownUrls,DownUrl_s,DownUrl_o,False,False)
else
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -