|
主题:科讯V9.4图片系统采集时不能采集图片组【已修复】 [收藏主题] |
图片系统采集时,本以为可以采集组图,结果只能采集第一个图片。为此,修改程序。或许我的修改又存在问题,问大家指出以便改进。我测试的采集是没有问题的。
废话不多说, 修改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 备注:红色为修改部分 |
|
个人QQ:845977434 | |
支持(0) | 反对(0) 顶端 底部 |
支持(0) | 反对(0) 顶端 底部 |
支持(0) | 反对(0) 顶端 底部 |
<上一主题 | 下一主题 > |