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

时间:2022-06-01 16:51:46
  1. '==================================================  
  2. '函数名:ReplaceSaveRemoteFile  
  3. '作  用:替换、保存远程图片  
  4. '参  数:ConStr ------ 要替换的字符串  
  5. '参  数:SaveTf ------ 是否保存文件,False不保存,True保存  
  6. '参  数: TistUrl------ 当前网页地址  
  7. '==================================================  
  8. Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl)  
  9.    If ConStr="$False$" or ConStr="" or strChannelDir="" Then  
  10.       ReplaceSaveRemoteFile=ConStr  
  11.       Exit Function  
  12.    End If  
  13.    Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2  
  14.  
  15.    Set Re = New Regexp   
  16.    Re.IgnoreCase = True   
  17.    Re.Global = True  
  18.    Re.Pattern ="<img.+?[^\>]>"  
  19.    Set Matches =Re.Execute(ConStr)   
  20.    For Each Match in Matches  
  21.       If TempStr<>"" then   
  22.          TempStr=TempStr & "$Array$" & Match.Value  
  23.       Else  
  24.          TempStr=Match.Value  
  25.       End if  
  26.    Next  
  27.    If TempStr<>"" Then  
  28.       TempArray=Split(TempStr,"$Array$")  
  29.       TempStr=""  
  30.       For Tempi=0 To Ubound(TempArray)  
  31.          Re.Pattern ="src\s*=\s*.+?\.(gif|jpg|bmp|jpeg|psd|png|svg|dxf|wmf|tiff)"  
  32.          Set Matches =Re.Execute(TempArray(Tempi))   
  33.          For Each Match in Matches  
  34.             If TempStr<>"" then   
  35.                TempStr=TempStr & "$Array$" & Match.Value  
  36.             Else  
  37.                TempStr=Match.Value  
  38.             End if  
  39.          Next  
  40.       Next  
  41.    End if  
  42.    If TempStr<>"" Then  
  43.          IncludePic=1'图片新闻  
  44.       Re.Pattern ="src\s*=\s*"  
  45.       TempStr=Re.Replace(TempStr,"")  
  46.    End If  
  47.    Set Matches=nothing  
  48.    Set Re=nothing  
  49.    If TempStr="" or IsNull(TempStr)=True Then  
  50.       ReplaceSaveRemoteFile=ConStr  
  51.       Exit function  
  52.    End if  
  53.    TempStr=Replace(TempStr,"""","")  
  54.    TempStr=Replace(TempStr,"'","")  
  55.    TempStr=Replace(TempStr," ","")  
  56.  
  57.    Dim RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path  
  58.    DtNow=Now()  
  59.    If SaveTf=True then  
  60.  '***********************************  
  61.       SavePath= strChannelDir & year(DtNow) & right("0" & month(DtNow),2) & "/"  
  62.       response.write "链接路径:" & savepath & "<br>"  
  63.       Arr_Path=Split(SavePath,"/")  
  64.       PathTemp=""  
  65.       For Tempi=0 To Ubound(Arr_Path)  
  66.          If Tempi=0 Then  
  67.             PathTemp=Arr_Path(0) & "/"  
  68.          ElseIf Tempi=Ubound(Arr_Path) Then  
  69.             Exit For  
  70.          Else  
  71.             PathTemp=PathTemp & Arr_Path(Tempi) & "/"  
  72.          End If  
  73.          If CheckDir(PathTemp)=False Then  
  74.             If MakeNewsDir(PathTemp)=False Then  
  75.                SaveTf=False  
  76.                Exit For  
  77.             End If  
  78.          End If  
  79.       Next  
  80.    End If  
  81.  
  82.    '去掉重复图片开始  
  83.    TempArray=Split(TempStr,"$Array$")  
  84.    TempStr=""  
  85.    For Tempi=0 To Ubound(TempArray)  
  86.       If Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 Then  
  87.          TempStr=TempStr & "$Array$" & TempArray(Tempi)  
  88.       End If  
  89.    Next  
  90.    TempStr=Right(TempStr,Len(TempStr)-7)  
  91.    TempArray=Split(TempStr,"$Array$")  
  92.    '去掉重复图片结束  
  93.  
  94.    '转换相对图片地址开始  
  95.    TempStr=""  
  96.    For Tempi=0 To Ubound(TempArray)  
  97.       TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)  
  98.    Next  
  99.    TempStr=Right(TempStr,Len(TempStr)-7)  
  100.    TempStr=Replace(TempStr,Chr(0),"")  
  101.    TempArray2=Split(TempStr,"$Array$")  
  102.    TempStr=""  
  103.    '转换相对图片地址结束  
  104.     '图片替换/保存  
  105.    Set Re = New Regexp  
  106.    Re.IgnoreCase = True   
  107.    Re.Global = True  
  108.    For Tempi=0 To Ubound(TempArray2)  
  109.       RemoteFileUrl=TempArray2(Tempi)  
  110.       If RemoteFileUrl<>"$False$" And SaveTf=True Then'保存图片  
  111.          ArrSaveFileName = Split(RemoteFileurl,".")  
  112.      strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'文件类型  
  113.          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  
  114.             UploadFiles=""  
  115.             ReplaceSaveRemoteFile=ConStr  
  116.             Exit Function  
  117.          End If  
  118.  
  119.          Randomize  
  120.          RanNum=Int(900*Rnd)+100  
  121.      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  
  122.          Re.Pattern =TempArray(Tempi)  
  123.  
  124.      If SaveRemoteFile(SavePath & strFileName,RemoteFileUrl)=True Then  
  125. '********************************  
  126.             PathTemp=SavePath & strFileName   
  127.             ConStr=Re.Replace(ConStr,PathTemp)  
  128.             Re.Pattern=strInstallDir & strChannelDir   
  129.             UploadFiles=UploadFiles & "|" & Re.Replace(SavePath &strFileName,"")  
  130.             Response.Flush()  
  131.             response.write "    图片保存地址:" & PathTemp & "<br>"  
  132.             if Thumb_WaterMark=1 then call SKThumb.AddWaterMark(PathTemp)'水印  
  133.          Else  
  134.             PathTemp=RemoteFileUrl  
  135.             ConStr=Re.Replace(ConStr,PathTemp)  
  136.             'UploadFiles=UploadFiles & "|" & RemoteFileUrl  
  137.          End If  
  138.       ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片  
  139.          Re.Pattern =TempArray(Tempi)  
  140.          ConStr=Re.Replace(ConStr,RemoteFileUrl)  
  141.          UploadFiles=UploadFiles & "|" & RemoteFileUrl  
  142.       End If  
  143.    Next     
  144.    Set Re=nothing  
  145.    If UploadFiles<>"" Then  
  146.       UploadFiles=Right(UploadFiles,Len(UploadFiles)-1)  
  147.    End If  
  148.    ReplaceSaveRemoteFile=ConStr  
  149. End function