ReplaceSaveRemoteFile替换、保存远程图片的代码
代码 远程 图片 保存 替换
2023-06-13 09:13:57 时间
"==================================================
"函数名: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
"作 用:替换、保存远程图片
"参 数: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
相关文章
- 正则表达式 – 去掉乱码字符/提取字符串中的中文字符/提取字符串中的大小写字母 – Python代码
- HTTP.sys远程执行代码漏洞验证及复现——CVE-2015-1635、MS15-034[通俗易懂]
- WordPress网站js防扒代码-禁止右键/F12/调试自动关闭窗口
- 【JavaScript】手把手教你写高质量 JavaScript 异步代码!
- goeval代码注入导致远程代码执行(2022虎符Final)
- 2022-08-05:以下go语言代码输出什么?A:65, string;B:A, string;C:65, int;D:报错。
- git从远程分支拉取代码_git更新分支下的代码
- Pycharm 调试代码显示错误行_pycharm远程调试
- git pull 从远程获取代码并合并本地的版本
- 【Android 逆向】Android 进程注入工具开发 ( 注入代码分析 | 远程调用 目标进程中 libc.so 动态库中的 mmap 函数 一 | mmap 函数简介 )
- 【Android 逆向】Android 进程注入工具开发 ( 注入代码分析 | 获取 linker 中的 dlopen 函数地址 并 通过 远程调用 执行该函数 )
- 【Android 逆向】Android 进程注入工具开发 ( 注入代码分析 | 获取注入的 libbridge.so 动态库中的 load 函数地址 并 通过 远程调用 执行该函数 )
- Python 进阶指南(编程轻松进阶):十二、使用 Git 组织您的代码项目
- java连接mysql示例代码详解编程语言
- 一行代码,轻松启动MySQL:批处理实现(批处理启动mysql)
- asp读取远程文件并保存到本地代码
- 用php获取远程图片并把它保存到本地的代码
- PHP文章中的远程图片采集到本地的代码
- 百度手写板代码JavaScript远程调用的实现(鼠标输入法)
- php实现进制转换(二进制、八进制、十六进制)互相转换实现代码
- 使用ThinkPHP自带的Http类下载远程图片到本地的实现代码
- PHP中将网页导出为Word文档的代码
- jquery获取标签名(tagName)示例代码
- adnroid已安装应用中检测某应用是否安装的代码实例
- java阶乘计算获得结果末尾0的个数代码实现
- 微信扫描二维码登录网站代码示例