ASP替换、保存远程图片实现代码
ASP通过函数来实现替换、保存远程图片,完成自动采集图片、提取图片的功能,函数中自动判断重复图片,智能分析链接路径,并转成成相对的图片地址保存在你指定的网站目录中,我们可将此函数用在后台的编辑器中,当你复制了含有图片的内容后,本代码会自动帮你上传图片。同时本代码也是采集程序中的重要处理函数,函数代码如下:
FunctionReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl) IfConStr="$False$"orConStr=""orstrInstallDir=""orstrChannelDir=""Then ReplaceSaveRemoteFile=ConStr ExitFunction EndIf DimTempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2 SetRe=NewRegexp Re.IgnoreCase=True Re.Global=True Re.Pattern="]>" SetMatches=Re.Execute(ConStr) ForEachMatchinMatches IfTempStr<>""then TempStr=TempStr&"$Array$"&Match.Value Else TempStr=Match.Value Endif Next IfTempStr<>""Then TempArray=Split(TempStr,"$Array$") TempStr="" ForTempi=0ToUbound(TempArray) Re.Pattern="src\s*=\s*.+?\.(gif|jpg|bmp|jpeg|psd|png|svg|dxf|wmf|tiff)" SetMatches=Re.Execute(TempArray(Tempi)) ForEachMatchinMatches IfTempStr<>""then TempStr=TempStr&"$Array$"&Match.Value Else TempStr=Match.Value Endif Next Next Endif IfTempStr<>""Then Re.Pattern="src\s*=\s*" TempStr=Re.Replace(TempStr,"") EndIf SetMatches=nothing SetRe=nothing IfTempStr=""orIsNull(TempStr)=TrueThen ReplaceSaveRemoteFile=ConStr Exitfunction Endif TempStr=Replace(TempStr,"""","") TempStr=Replace(TempStr,"'","") TempStr=Replace(TempStr,"","") DimRemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path DtNow=Now() IfSaveTf=Truethen SavePath=strChannelDir&"/"&year(DtNow)&right("0"&month(DtNow),2)&"/" response.write"链接路径:"&savepath&"" Arr_Path=Split(SavePath,"/") PathTemp="" ForTempi=0ToUbound(Arr_Path) IfTempi=0Then PathTemp=Arr_Path(0)&"/" ElseIfTempi=Ubound(Arr_Path)Then ExitFor Else PathTemp=PathTemp&Arr_Path(Tempi)&"/" EndIf IfCheckDir(PathTemp)=FalseThen IfMakeNewsDir(PathTemp)=FalseThen SaveTf=False ExitFor EndIf EndIf Next EndIf '去掉重复图片 TempArray=Split(TempStr,"$Array$") TempStr="" ForTempi=0ToUbound(TempArray) IfInstr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1Then TempStr=TempStr&"$Array$"&TempArray(Tempi) EndIf Next TempStr=Right(TempStr,Len(TempStr)-7) TempArray=Split(TempStr,"$Array$") '转换相对图片地址 TempStr="" ForTempi=0ToUbound(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="" '图片替换/保存 SetRe=NewRegexp Re.IgnoreCase=True Re.Global=True ForTempi=0ToUbound(TempArray2) RemoteFileUrl=TempArray2(Tempi) IfRemoteFileUrl<>"$False$"AndSaveTf=TrueThen'保存图片 ArrSaveFileName=Split(RemoteFileurl,".") strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'文件类型 IfstrFileType="asp"orstrFileType="asa"orstrFileType="aspx"orstrFileType="cer"orstrFileType="cdx"orstrFileType="exe"orstrFileType="rar"orstrFileType="zip"then UploadFiles="" ReplaceSaveRemoteFile=ConStr ExitFunction EndIf 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) IfSaveRemoteFile(SavePath&strFileName,RemoteFileUrl)=TrueThen '******************************** 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 EndIf ElseIfRemoteFileurl<>"$False$"andSaveTf=FalseThen'不保存图片 Re.Pattern=TempArray(Tempi) ConStr=Re.Replace(ConStr,RemoteFileUrl) UploadFiles=UploadFiles&"|"&RemoteFileUrl EndIf Next SetRe=nothing IfUploadFiles<>""Then UploadFiles=Right(UploadFiles,Len(UploadFiles)-1) EndIf ReplaceSaveRemoteFile=ConStr Endfunction
函数参数说明:
ConStr:要替换的字符串
参数:SaveTf:是否保存文件,False不保存,True保存
参数:TistUrl:当前网页地址
以上就是ASP替换、保存远程图片函数代码,希望对大家的学习有所帮助。