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替换、保存远程图片函数代码,希望对大家的学习有所帮助。