源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

ReplaceSaveRemoteFile 替换、保存远程图片 的代码

  • 时间:2021-07-19 03:16 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:ReplaceSaveRemoteFile 替换、保存远程图片 的代码
'================================================== '函数名: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
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部