📄 cs_function.asp
字号:
ReturnValue = GetOneNewsReturnValue(4,i + 1,TitleStr,ContentStr,NewsLinkStr) & ReturnValue
if IsNull(HandSetAuthor) OR (HandSetAuthor = "") then
AuthorStr = LoseHtml(GetOtherContent(NewsPageStr,AuthorHeadSetting,AuthorFootSetting))
else
AuthorStr = HandSetAuthor
end if
if IsNull(HandSetSource) OR (HandSetSource = "") then
SourceStr = LoseHtml(GetOtherContent(NewsPageStr,SourceHeadSetting,SourceFootSetting))
else
SourceStr = HandSetSource
end if
if IsNull(HandSetAddDate) OR Not IsDate(HandSetSource) then
AddDate = LoseHtml(GetOtherContent(NewsPageStr,AddDateHeadSetting,AddDateFootSetting))
else
AddDate = HandSetSource
end if
if AddDate <> "" then
if Not IsDate(AddDate) then AddDate = Now
else
AddDate = Now
end if
SaveCollectContent TitleStr,NewsLinkStr,ContentStr,AuthorStr,SourceStr,AddDate
end if
end if
Set RsCheckNewsObj = Nothing
else
ReturnValue = GetOneNewsReturnValue(5,i + 1,"","",NewsLinkStr) & ReturnValue
end if
else
ReturnValue = GetOneNewsReturnValue(5,i + 1,"","",NewsLinkStr) & ReturnValue
end if
else
ReturnValue = GetOneNewsReturnValue(5,i + 1,"","",NewsLinkStr) & ReturnValue
end if
Next
CollectStartLocation = i
End Function
Function ResumeGetNewsPageContent()
dim ResumeSql,RsResumeNewsObj,ResumeNewsURL,ResumeNewsURL1,ResumeNewsLocation
ResumeSql = "Select top 1 Links from FS_News where SiteID='" & CollectingSiteID &"' order by ID DESC"
Set RsResumeNewsObj = CollectConn.Execute(ResumeSql)
If RsResumeNewsObj.EOF Then
set RsResumeNewsObj = nothing
response.Write("<script>alert(""无法确定您以前的采集记录，\n续采失败！"");history.go(-2);</script>")
else
ResumeNewsURL = RsResumeNewsObj("Links")
set RsResumeNewsObj = nothing
End If
Dim NewsPageStr,TitleStr,ContentStr,AuthorStr,SourceStr,AddDate,i,n
Dim ResponseAllStr,NewsListStr,NewsLinkStr,RsCheckNewsObj
Dim NewsListStrArray,TempArray
ResponseAllStr = GetPageContent(FormatUrl(ObjURL,CollectObjURL),WebCharset)
if ResponseAllStr = False then
CollectPageNumber = CollectPageNumber + 1
ReturnValue = ReturnValue & "<br> <strong>错误</strong>:读取新闻列表页面失败<br>"
Exit Function
end if
Dim BLinkHeadSetting,BLinkFootSetting
BLinkHeadSetting = False
BLinkFootSetting = False
If Instr(LinkHeadSetting,"[变量]")<=0 Then
BLinkHeadSetting = True
elseif Instr(LinkFootSetting,"[变量]")<=0 Then
BLinkFootSetting = True
End If
If InStr(ResponseAllStr,ListHeadSetting)>0 And InStr(ResponseAllStr,ListFootSetting) Then
NewsListStr = GetOtherContent(ResponseAllStr,ListHeadSetting,ListFootSetting)
Else
NewsListStr = ResponseAllStr
End If
If BLinkHeadSetting Then
NewsListStr = Mid(NewsListStr,Instr(NewsListStr,LinkHeadSetting)+len(LinkHeadSetting))
NewsListStrArray = Split(NewsListStr,LinkHeadSetting)
elseif BLinkFootSetting Then
NewsListStr = Left(NewsListStr,InstrRev(NewsListStr,LinkFootSetting))
NewsListStrArray = Split(NewsListStr,LinkFootSetting)
End If
For n = 0 to UBound(NewsListStrArray)
Dim tempURL
tempURL=LoseHtml(FormatUrl(GetOtherContent(LinkHeadSetting&NewsListStrArray(n),LinkHeadSetting,LinkFootSetting),CollectObjURL))
If ResumeNewsURL = tempURL Then
Exit For
ElseIf n>=UBound(NewsListStrArray) Then
AllNewsNumber = AllNewsNumber+n
CollectPageNumber = CollectPageNumber + 1
CollectStartLocation = 0
CollectedPageURL = ObjURL
Exit Function
End If
Next
CollectStartLocation = n+1
If IsReverse="1" then '倒序采集
Dim TempArr,j
TempArr=NewsListStrArray
For j =0 to UBound(NewsListStrArray)
NewsListStrArray(j)=TempArr(UBound(NewsListStrArray)-j)
Next
End If
For i = CollectStartLocation to CollectStartLocation + CollectMaxOfOnePage - 1
if i > UBound(NewsListStrArray) Then
CollectPageNumber = CollectPageNumber + 1
CollectStartLocation = 0
CollectedPageURL = ObjURL
Exit Function
end If
AllNewsNumber = AllNewsNumber + 1
If BLinkHeadSetting Then
TempArray = GetOtherContent(LinkHeadSetting&NewsListStrArray(i),LinkHeadSetting,LinkFootSetting)
elseif BLinkFootSetting Then
TempArray = GetOtherContent(NewsListStrArray(i)&LinkFootSetting,LinkHeadSetting,LinkFootSetting)
End If
if TempArray <> "" Then
NewsLinkStr = LoseHtml(FormatUrl(TempArray,CollectObjURL))
Set RsCheckNewsObj = CollectConn.Execute("Select * from FS_News where Links='" & NewsLinkStr & "'")
if RsCheckNewsObj.Eof then
NewsPageStr = GetPageContent(NewsLinkStr,WebCharset)
if NewsPageStr <> False then
TitleStr = LoseHtml(GetOtherContent(NewsPageStr,PageTitleHeadSetting,PageTitleFootSetting))
Set RsCheckNewsObj = CollectConn.Execute("Select * from FS_News where Links='" & NewsLinkStr & "'")
ContentStr = ReplaceKeyWords(GetOneNewsContent(NewsPageStr,NewsLinkStr))
ContentStr = ReplaceContentStr(ContentStr)
if SaveRemotePic then ContentStr = ReplaceIMGRemoteUrl(ContentStr,SaveIMGPath,p_DoMain_Str,p_SYS_ROOT_DIR,NewsLinkStr,SaveRemotePic,WaterPrintTF)
if TitleStr = "" then
ReturnValue = GetOneNewsReturnValue(2,i + 1,"","",NewsLinkStr) & ReturnValue
elseif ContentStr = "" then
ReturnValue = GetOneNewsReturnValue(3,i + 1,TitleStr,"",NewsLinkStr) & ReturnValue
else
ReturnValue = GetOneNewsReturnValue(4,i + 1,TitleStr,ContentStr,NewsLinkStr) & ReturnValue
if IsNull(HandSetAuthor) OR (HandSetAuthor = "") then
AuthorStr = LoseHtml(GetOtherContent(NewsPageStr,AuthorHeadSetting,AuthorFootSetting))
else
AuthorStr = HandSetAuthor
end if
if IsNull(HandSetSource) OR (HandSetSource = "") then
SourceStr = LoseHtml(GetOtherContent(NewsPageStr,SourceHeadSetting,SourceFootSetting))
else
SourceStr = HandSetSource
end if
if IsNull(HandSetAddDate) OR Not IsDate(HandSetAddDate) then
AddDate = LoseHtml(GetOtherContent(NewsPageStr,AddDateHeadSetting,AddDateFootSetting))
else
AddDate = HandSetAddDate
end if
if AddDate <> "" then
if Not IsDate(AddDate) then AddDate = Now
else
AddDate = Now
end if
SaveCollectContent TitleStr,NewsLinkStr,ContentStr,AuthorStr,SourceStr,AddDate
end if
Set RsCheckNewsObj = Nothing
else
ReturnValue = GetOneNewsReturnValue(5,i + 1,"","",NewsLinkStr) & ReturnValue
End If
ElseIf session("ConfirmCollectRevert")<>"ConfirmCollectRevert" Then
session("ConfirmCollectRevert") = "ConfirmCollectRevert"
response.write("<script>if(confirm(""您改变过采集顺序吗？\n如果修改过，请单击确定改回原样再续采！\n没有修改过请单击取消继续！""))window.location=""site.asp""</script>")
End If
End If
Next
CollectStartLocation = i
End Function
Function GetOneNewsContent(FirstPageContent,NewsLinkStr)
Dim OtherPageNewsLink,OtherPageNewsContentStr,tempSplitArr1,tempSplitArr2
Dim f_Collect_Index,f_Temp_Array,f_URL,f_Start,f_End,f_Int,f_I
'On Error Resume Next
f_Collect_Index = 0
OtherPageNewsContentStr = FirstPageContent
GetOneNewsContent = GetOtherContent(FirstPageContent,PagebodyHeadSetting,PagebodyFootSetting)
Select Case OtherNewsType
Case 0
Case 1
if IsNull(OtherNewsPageHeadSetting) OR IsNull(OtherNewsPageFootSetting) OR (OtherNewsPageHeadSetting = "") OR (OtherNewsPageFootSetting = "") Then
OtherPageNewsLink = ""
ElseIf InStr(OtherPageNewsContentStr,OtherNewsPageFootSetting)>0 And InStr(OtherPageNewsContentStr,OtherNewsPageHeadSetting)>0 Then
tempSplitArr1 = Split(OtherPageNewsContentStr,OtherNewsPageFootSetting)
tempSplitArr2 = Split(tempSplitArr1(0),OtherNewsPageHeadSetting)
OtherPageNewsLink = tempSplitArr2(Ubound(tempSplitArr2))
Else
OtherPageNewsLink = GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
End If
Do While (OtherPageNewsLink <> "")
OtherPageNewsLink = FormatUrl(OtherPageNewsLink,NewsLinkStr)
OtherPageNewsContentStr = GetPageContent(OtherPageNewsLink,WebCharset)
If InStr(OtherPageNewsContentStr,OtherNewsPageHeadSetting)>0 And InStr(OtherPageNewsContentStr,OtherNewsPageFootSetting)>0 Then
tempSplitArr1 = Split(OtherPageNewsContentStr,OtherNewsPageFootSetting)
tempSplitArr2 = Split(tempSplitArr1(0),OtherNewsPageHeadSetting)
OtherPageNewsLink = tempSplitArr2(Ubound(tempSplitArr2))
Else
OtherPageNewsLink = GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
End If
If OtherPageNewsContentStr<>False Then
GetOneNewsContent = GetOneNewsContent & "[FS:PAGE]" & GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
Else
OtherPageNewsLink = ""
End If
If Err Then
Err.clear
OtherPageNewsLink = ""
End If
Loop
If Right(GetOneNewsContent,9) = "[FS:PAGE]" Then
GetOneNewsContent = Left(GetOneNewsContent,Len(GetOneNewsContent) - 9)
End iF
Case 2
Dim Temp_NewsPageStr,Temp_NewsFistStr,Temp_NewsArray1,Temp_NewsArray2
If IsNull(OtherNewsPageIndexSetting) Or OtherNewsPageIndexSetting = "" Then
OtherPageNewsLink = ""
Else
If InStr(OtherNewsPageIndexSetting,"[分页新闻]")>0 And InStr(OtherNewsPageIndexSetting,"[变量]")>0 Then
tempSplitArr1 = Split(OtherNewsPageIndexSetting,"[分页新闻]")
tempSplitArr2 = Split(tempSplitArr1(1),"[变量]")
Temp_NewsPageStr = tempSplitArr2(0)
Temp_NewsFistStr = tempSplitArr1(0)
End If
If InStr(OtherPageNewsContentStr,Temp_NewsFistStr)>0 And InStr(OtherPageNewsContentStr,Temp_NewsPageStr)>0 Then
Temp_NewsArray1 = Split(OtherPageNewsContentStr,Temp_NewsFistStr)
Temp_NewsArray2 = Split(Temp_NewsArray1(1),Temp_NewsPageStr)
OtherPageNewsLink = Temp_NewsArray2(0)
Else
OtherPageNewsLink = GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
End If
End If
Do While (OtherPageNewsLink <> "")
OtherPageNewsLink = FormatUrl(OtherPageNewsLink,NewsLinkStr)
OtherPageNewsContentStr = GetPageContent(OtherPageNewsLink,WebCharset)
If InStr(OtherPageNewsContentStr,Temp_NewsFistStr)>0 And InStr(OtherPageNewsContentStr,Temp_NewsPageStr)>0 Then
Temp_NewsArray1 = Split(OtherPageNewsContentStr,Temp_NewsFistStr)
Temp_NewsArray2 = Split(Temp_NewsArray1(1),Temp_NewsPageStr)
OtherPageNewsLink = Temp_NewsArray2(0)
Else
OtherPageNewsLink = GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
End If
If OtherPageNewsContentStr <> False Then
GetOneNewsContent = GetOneNewsContent & "[FS:PAGE]" & GetOtherContent(OtherPageNewsContentStr,PagebodyHeadSetting,PagebodyFootSetting)
Else
OtherPageNewsLink = ""
End If
If Err Then
Err.clear
OtherPageNewsLink = ""
End If
Loop
If Right(GetOneNewsContent,9) = "[FS:PAGE]" Then
GetOneNewsContent = Left(GetOneNewsContent,Len(GetOneNewsContent) - 9)
End iF
End Select
End Function
Function GetOneNewsReturnValue(CauseIndex,NewsIndex,Title,Content,LinkStr)
Select Case CauseIndex
Case 1 '不允许重名保存
GetOneNewsReturnValue = "</br> <strong>序号</strong>： " & NewsIndex
GetOneNewsReturnValue = GetOneNewsReturnValue & " <strong>结果</strong>： <font color=red>已经采集，在等待审核或者在历史纪录里面</font>"
GetOneNewsReturnValue = GetOneNewsReturnValue & "<br> <strong>标题</strong>： " & Title
GetOneNewsReturnValue = GetOneNewsReturnValue & "<br> <strong>新闻链接</strong>： <a target=""_blank"" href=""" & LinkStr & """>" & LinkStr & "</a><br>"
Case 2 '标题为空，没有保存
GetOneNewsReturnValue = "</br> <strong>序号</strong>： " & NewsIndex
GetOneNewsReturnValue = GetOneNewsReturnValue & " <strong>结果</strong>： <font color=red>标题为空，没有保存</font>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -