ASP通过函数来实现替换、保存远程图片,完成自动采集图片、提取图片的功能,函数中自动判断重复图片,智能分析链接路径,并转成成相对的图片地址保存在你指定的网站目录中,我们可将此函数用在后台的编辑器中,当你复制了含有图片的内容后,本代码会自动帮你上传图片。同时本代码也是采集程序中的重要处理函数,函数代码如下:
Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl) If ConStr="$False$" or ConStr="" or strInstallDir="" or strChannelDir="" Then ReplaceSaveRemoteFile=ConStr Exit Function End If Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2 Set Re = New Regexp Re.IgnoreCase = True Re.Global = True Re.Pattern ="]>" Set Matches =Re.Execute(ConStr) For Each Match in Matches If TempStr<>"" then TempStr=TempStr & "$Array$" & Match.Value Else TempStr=Match.Value End if Next If TempStr<>"" Then TempArray=Split(TempStr,"$Array$") TempStr="" For Tempi=0 To Ubound(TempArray) Re.Pattern ="src\s*=\s*.+" Set Matches =Re.Execute(TempArray(Tempi)) For Each Match in Matches If TempStr<>"" then TempStr=TempStr & "$Array$" & Match.Value Else TempStr=Match.Value End if Next Next End if If TempStr<>"" Then Re.Pattern ="src\s*=\s*" TempStr=Re.Replace(TempStr,"") End If Set Matches=nothing Set Re=nothing If TempStr="" or IsNull(TempStr)=True Then ReplaceSaveRemoteFile=ConStr Exit function End if TempStr=Replace(TempStr,"""","") TempStr=Replace(TempStr,"'","") TempStr=Replace(TempStr," ","") Dim RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path DtNow=Now() If SaveTf=True then SavePath= strChannelDir & "/" & year(DtNow) & right("0" & month(DtNow),2) & "/" response.write "链接路径:" & savepath & "" Arr_Path=Split(SavePath,"/") PathTemp="" For Tempi=0 To Ubound(Arr_Path) If Tempi=0 Then PathTemp=Arr_Path(0) & "/" ElseIf Tempi=Ubound(Arr_Path) Then Exit For Else PathTemp=PathTemp & Arr_Path(Tempi) & "/" End If If CheckDir(PathTemp)=False Then If MakeNewsDir(PathTemp)=False Then SaveTf=False Exit For End If End If Next End If '去掉重复图片 TempArray=Split(TempStr,"$Array$") TempStr="" For Tempi=0 To Ubound(TempArray) If Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 Then TempStr=TempStr & "$Array$" & TempArray(Tempi) End If Next TempStr=Right(TempStr,Len(TempStr)-7) TempArray=Split(TempStr,"$Array$") '转换相对图片地址 TempStr="" For Tempi=0 To Ubound(TempArray) TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl) Next TempStr=Right(TempStr,Len(TempStr)-7) TempStr=Replace(TempStr,Chr(0),"") TempArray2=Split(TempStr,"$Array$") TempStr="" '图片替换/保存 Set Re = New Regexp Re.IgnoreCase = True Re.Global = True For Tempi=0 To Ubound(TempArray2) RemoteFileUrl=TempArray2(Tempi) If RemoteFileUrl<>"$False$" And SaveTf=True Then'保存图片 ArrSaveFileName = Split(RemoteFileurl,".") strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'文件类型 If strFileType="asp" or strFileType="asa" or strFileType="aspx" or strFileType="cer" or strFileType="cdx" or strFileType="exe" or strFileType="rar" or strFileType="zip" then UploadFiles="" ReplaceSaveRemoteFile=ConStr Exit Function End If Randomize RanNum=Int(900*Rnd)+100 strFileName = year(DtNow) & right("0" & month(DtNow),2) & right("0" & day(DtNow),2) & right("0" & hour(DtNow),2) & right("0" & minute(DtNow),2) & right("0" & second(DtNow),2) & ranNum & "." & strFileType Re.Pattern =TempArray(Tempi) If SaveRemoteFile(SavePath & strFileName,RemoteFileUrl)=True Then '******************************** PathTemp=SavePath & strFileName ConStr=Re.Replace(ConStr,PathTemp) Re.Pattern=strInstallDir & strChannelDir & "/" UploadFiles=UploadFiles & "|" & Re.Replace(SavePath &strFileName,"") Else PathTemp=RemoteFileUrl ConStr=Re.Replace(ConStr,PathTemp) 'UploadFiles=UploadFiles & "|" & RemoteFileUrl End If ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片 Re.Pattern =TempArray(Tempi) ConStr=Re.Replace(ConStr,RemoteFileUrl) UploadFiles=UploadFiles & "|" & RemoteFileUrl End If Next Set Re=nothing If UploadFiles<>"" Then UploadFiles=Right(UploadFiles,Len(UploadFiles)-1) End If ReplaceSaveRemoteFile=ConStr End function
函数参数说明:
ConStr:要替换的字符串
参 数:SaveTf:是否保存文件,False不保存,True保存
参 数: TistUrl:当前网页地址
以上就是ASP替换、保存远程图片函数代码,希望对大家的学习有所帮助。
华山资源网 Design By www.eoogi.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
华山资源网 Design By www.eoogi.com
暂无评论...
更新日志
2024年12月25日
2024年12月25日
- 小骆驼-《草原狼2(蓝光CD)》[原抓WAV+CUE]
- 群星《欢迎来到我身边 电影原声专辑》[320K/MP3][105.02MB]
- 群星《欢迎来到我身边 电影原声专辑》[FLAC/分轨][480.9MB]
- 雷婷《梦里蓝天HQⅡ》 2023头版限量编号低速原抓[WAV+CUE][463M]
- 群星《2024好听新歌42》AI调整音效【WAV分轨】
- 王思雨-《思念陪着鸿雁飞》WAV
- 王思雨《喜马拉雅HQ》头版限量编号[WAV+CUE]
- 李健《无时无刻》[WAV+CUE][590M]
- 陈奕迅《酝酿》[WAV分轨][502M]
- 卓依婷《化蝶》2CD[WAV+CUE][1.1G]
- 群星《吉他王(黑胶CD)》[WAV+CUE]
- 齐秦《穿乐(穿越)》[WAV+CUE]
- 发烧珍品《数位CD音响测试-动向效果(九)》【WAV+CUE】
- 邝美云《邝美云精装歌集》[DSF][1.6G]
- 吕方《爱一回伤一回》[WAV+CUE][454M]