'==================================================
'函数名：ReplaceSaveRemoteFile
'作用：替换、保存远程图片
'参数：ConStr------要替换的字符串
'参数：SaveTf------是否保存文件，False不保存，True保存
'参数:TistUrl------当前网页地址
'==================================================
FunctionReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl)
IfConStr="$False$"orConStr=""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="<img.+?[^>]>"
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="srcs*=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
IncludePic=1'图片新闻
Re.Pattern="srcs*=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&"<br>"
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,"")
Response.Flush()
response.write"图片保存地址："&PathTemp&"<br>"
ifThumb_WaterMark=1thencallSKThumb.AddWaterMark(PathTemp)'水印
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
【ReplaceSaveRemoteFile 替换、保存远程图片 的代码】相关文章：
★ 用ASP VBS xmlhttp adodbstream下载和保存图片的代码