- '==================================================
- '函数名:ReplaceSaveRemoteFile
- '作 用:替换、保存远程图片
- '参 数:ConStr ------ 要替换的字符串
- '参 数:SaveTf ------ 是否保存文件,False不保存,True保存
- '参 数: TistUrl------ 当前网页地址
- '==================================================
- Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl)
- If ConStr="$False$" or ConStr="" 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 ="<img.+?[^\>]>"
- 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*.+?\.(gif|jpg|bmp|jpeg|psd|png|svg|dxf|wmf|tiff)"
- 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
- IncludePic=1'图片新闻
- 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 & "<br>"
- 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,"")
- Response.Flush()
- response.write " 图片保存地址:" & PathTemp & "<br>"
- if Thumb_WaterMark=1 then call SKThumb.AddWaterMark(PathTemp)'水印
- 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
ReplaceSaveRemoteFile 替换、保存远程图片 的代码
2019-10-09 14:24asp代码网 ASP教程
ReplaceSaveRemoteFile 替换、保存远程图片 的代码
延伸 · 阅读
- 2022-03-10python保存两位小数的多种方法汇总
- 2022-03-07如何替换@PathVariable中的变量
- 2022-02-28致美发型设计为什么搜不到?致美发型设计怎么
- 2022-02-20Java实现获取小程序带参二维码并保存到本地
- 2022-02-17C#抓取网络图片保存到本地的实现方法
- 2022-02-15C# 创建EXCEL图表并保存为图片的实例
- ASP教程
asp 标记字符串中指定字符变色不区分大小写
今天遇到这种问题,单纯的使用replace函数不行,他会改变原有的字符串的大小写,在网上找到相关的代码,自己备份下...
- ASP教程
最小asp后门程序
这个代码,一般不会 被病毒查杀,而且文件比较小,不容易被怀疑,可以放到别的asp文件中,起到隐藏的目的 ...
- ASP教程
CreateKeyWord asp实现的由给定的字符串生成关键字的代码
CreateKeyWord asp实现的由给定的字符串生成关键字的代码 ...
- ASP教程
一个改进的ASP生成SQL命令字符串类的代码[已测]
网上找资料发现的,但是调试的时候发现有一些问题,改了一下,还有一定的问题,但是可以做一般使用了。没有考虑数据类型的问题,还有SQL Server 和a...
- ASP教程
asp最简单最实用的计数器
刚才找一个计数器,由于网站的访问量太少,放个计数器在那里确实有点寒酸了,于是呼只能搞一个简单点的,可以访问一次就记录一次的来撑撑门面先。...
- ASP教程
asp 采集实战代码
最近实在是太流行采集了,本人是不喜欢采集的,但对采集的原理我却很有兴趣进行研究,拿到了网上采集常用函数,对其进行了一番研究,并实战,结果...
- ASP教程
使用ASP记录在线用户的数量的代码
网络的访问量是每一个做网站的网友们都非常关心的问题。如何得知有多少个人正在访问你的网站呢?如何将每天的访问量记录下来?下面就是一个解决方...
- ASP教程
ASP编程入门进阶(五):内置对象Response
通过对Request对象的学习,可以了解到,Request对象是服务器端用来获取客户端的信息的。 但作为服务器和客户端进行交互,是不是还缺少服务器端向客户端...