图片系统采集时，本以为可以采集组图，结果只能采集第一个图片。为此，修改程序。或许我的修改又存在问题，问大家指出以便改进。我测试的采集是没有问题的。
废话不多说，
修改asp文件
/Collect/Collect_ItemCollecFast.asp


If FoundErr <> True Then



   



If KS.C_S(ChannelID,6)="2" Then  '图片模型

    Tp_AddressList_Code=KMCObj.GetBody(NewsCode, Tp_Lists, Tp_Listo, False, False)

'Tp_Url=KMCObj.GetBody(Tp_AddressList_Code, Tp_srcs, Tp_srco, False, False)

Tp_Url=KMCObj.GetArray(Tp_AddressList_Code, Tp_srcs, Tp_srco, False, False)

If Tp_Url="Error" Then

'Tp_Url=KMCObj.GetBody(NewsCode, Tp_srcs, Tp_srco, False, False)

Tp_Url=KMCObj.GetArray(NewsCode, Tp_srcs, Tp_srco, False, False)

End If

If Tp_Url="Error" Then

   FoundErr = True

   ErrMsg = ErrMsg & "<br>在分析：" & NewsUrl & "的单张图片地址发生错误"

   Title = Title & "<br>单张图片地址分析错误"

End If

If Tp_is<>"" and Tp_Io<>"" Then

'Tp_Intro=KMCObj.GetBody(Tp_AddressList_Code, Tp_is, Tp_io, False, False)

Tp_Intro=KMCObj.GetArray(Tp_AddressList_Code, Tp_is, Tp_io, False, False)

End If

If Tp_Intro="Error" Then

  'Tp_Intro=KMCObj.GetBody(NewsCode, Tp_is, Tp_io, False, False)

  Tp_Intro=KMCObj.GetArray(NewsCode, Tp_is, Tp_io, False, False)

End If

If Tp_Intro="Error" Then Tp_Intro=""


'2014 03 21 Start

If Tp_Intro="" Then Tp_Intro=Title '不设置图片标题时，取图片标题名

If ubound(split(Tp_Url,"$Array$"))>0 Then

  Dim Tp_Url_Array,Tp_Url_Num,Tp_Url_i,Tp_Url_Format,Tp_Url_Url,Tp_Url_Upl

  Dim Tp_Intro_Array,Tp_Intro_Num,Tp_Intro_Str

  Tp_Url_Array=split(Tp_Url,"$Array$")

  Tp_Url_Num=ubound(Tp_Url_Array)

  Tp_Intro_Array=split(Tp_Intro,"$Array$")

  Tp_Intro_Num=ubound(Tp_Intro_Array)

  Tp_Url_Url=""

  tp_str=""

  Tp_Url_Upl=""

  For Tp_Url_i=0 to Tp_Url_Num

    If ubound(split(Tp_Url_Array(Tp_Url_i),".")) > 0 Then

  Tp_Url_Format=Mid(Tp_Url_Array(Tp_Url_i),InStrRev(Tp_Url_Array(Tp_Url_i),".")) '图片格式

  If Len(Tp_Url_Format)=4 Then '判断后缀 是否为图片

    'Response.Write Tp_Url_Array(Tp_Url_i)&"<br />" '测试采集到的图片地址

Tp_Intro_Str="" '初始化图片名称

If Tp_Intro_Num>=Tp_Url_i Then '判断是否取到对应的图片名

  Tp_Intro_Str=Tp_Intro_Array(Tp_Url_i)

Else

  Tp_Intro_Str=Tp_Intro_Array(0)

End If

SaveFileName = Year(Now()) & Month(Now()) & Day(Now()) & KS.MakeRandom(10) & Tp_Url_Format

Call KS.SaveBeyondFile(KS.GetUpFilesDir & "/" & SaveFileName,KMCObj.DefiniteUrl(Tp_Url_Array(Tp_Url_i), NewsUrl))

Tp_Url_Url=KS.Setting(2) & KS.GetUpFilesDir & "/" & SaveFileName

tp_str=tp_str&Replace(Tp_Intro_Str,"|","")&"|" & Tp_Url_Url & "|" & Tp_Url_Url & "|||"

If Tp_Url_Upl="" Then '记录采集的图片数

  Tp_Url_Upl=Tp_Url_Url

Else

  Tp_Url_Upl=Tp_Url_Upl&"|"&Tp_Url_Url

End IF

  End If

End If

  Next

  tp_str=left(tp_str, InStrRev(tp_str,"|||"))

Else

  If CollecTest = False And BeyondSavePic = 1 Then '存图

SaveFileName = Year(Now()) & Month(Now()) & Day(Now()) & KS.MakeRandom(10) & Mid(Tp_Url, InStrRev(Tp_Url, "."))

Call KS.SaveBeyondFile(KS.GetUpFilesDir & "/" & SaveFileName,KMCObj.DefiniteUrl(Tp_Url, NewsUrl))

Tp_Url=KS.Setting(2) & KS.GetUpFilesDir & "/" & SaveFileName

  End If

  tp_str=Replace(Tp_Intro,"|","")&"|" & Tp_Url & "|" & Tp_Url

  

End If



If Tp_Url_Upl<>"" Then UploadFiles=Tp_Url_Upl

If UploadFiles="" Then

  UploadFiles=Tp_Url

Else

  UploadFiles=UploadFiles & "|" & Tp_Url

End If


'Response.Write tp_str

'Response.end

'2014 03 21 End





'图片分页

If NewsPageType = 1 Then



备注：红色为修改部分

asp路径错了 应该是  /admin/Collect/Collect_ItemCollecFast.asp

记录，以备用！



科汛讨论高手群：25708743，欢迎大家加入，有问题欢迎讨论！