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

时间: 2024-09-29 08:40:39

ReplaceSaveRemoteFile 替换、保存远程图片 的代码的相关文章

ASP替换、保存远程图片实现代码_应用技巧

ASP通过函数来实现替换.保存远程图片,完成自动采集图片.提取图片的功能,函数中自动判断重复图片,智能分析链接路径,并转成成相对的图片地址保存在你指定的网站目录中,我们可将此函数用在后台的编辑器中,当你复制了含有图片的内容后,本代码会自动帮你上传图片.同时本代码也是采集程序中的重要处理函数,函数代码如下: Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl) If ConStr="$Fa

ASP替换、保存远程图片实现代码

ASP通过函数来实现替换.保存远程图片,完成自动采集图片.提取图片的功能,函数中自动判断重复图片,智能分析链接路径,并转成成相对的图片地址保存在你指定的网站目录中,我们可将此函数用在后台的编辑器中,当你复制了含有图片的内容后,本代码会自动帮你上传图片.同时本代码也是采集程序中的重要处理函数,函数代码如下: Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl) If ConStr="$Fa

asp.net保存远程图片的代码_实用技巧

注意:并没有实现CSS中的图片采集,且图片的正则还有待完善. 复制代码 代码如下: using System; using System.Data; using System.Configuration; using System.Web; using System.Web.Security; using System.Web.UI; using System.Web.UI.WebControls; using System.Web.UI.WebControls.WebParts; using

ASP保存远程图片到本地 同时取得第一张图片并创建缩略图的代码_应用技巧

采集中 或者 在线添加文章中 都可以用到此功能 俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂 俺从 SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取了点函数 用下 比较简单好用 以下是函数 程序代码  复制代码 代码如下: <% '================================================== '函数名:CheckDir2 '作 用:检查文件夹是否存在 '参 数:FolderP

asp下实现替换远程文件为本地文件并保存远程文件的代码_应用技巧

1.将下面的文本文件下载,并将.TXT改为remote.asp,里面有具体设置方法 复制代码 代码如下: <%  '添加资源时是否保存远程图片 Const sSaveFileSelect=True '远程图片保存目录,结尾请不要加"/" Const sSaveFilePath="/images/News" '远程图片保存类型 Const sFileExt="jpg|gif|bmp|png" '////////////////////////

保存远程图片函数修改正版

函数 趁今天有空,修正了一下这个函数,经测试,在本地服务器通过,在空间商服务器也可正常使用,没发现错误.我的卡巴斯基不报毒了.^_^ 只要修改一下,这个函数是放在哪个网站都适用的.在此只与添加图片为例说明一下调用方法,其它位置方法类似. 在我本机测试成功,由于现在连不上空间的FTP,所以无办在空间上测试,发现问题请到群中提出. 一.把下面函数放到Ft_admin_conn.asp的最后 '=================================='=函 数 名:saveimgfile'

ASP保存远程图片

记得很多的编辑器.自动采集系统都一个自动保存远程图片的功能,大概原理就是利用xmlhttp对象获取图片,然后用流对象写入保存,参照网上的代码,自己写了一个,与流传的代码没什么区别!代码如下,就一个函数: <% Function SaveRemoteFile(sSavePath,sRemoteFileUrl) On Error Resume Next SaveRemoteFile = False Dim oXML : Set oXML = Server.CreateObject("Micro

保存远程图片函数修改正版_小偷/采集

趁今天有空,修正了一下这个函数,经测试,在本地服务器通过,在空间商服务器也可正常使用,没发现错误.我的卡巴斯基不报毒了.^_^ 只要修改一下,这个函数是放在哪个网站都适用的.在此只与添加图片为例说明一下调用方法,其它位置方法类似. 在我本机测试成功,由于现在连不上空间的FTP,所以无办在空间上测试,发现问题请到群中提出. 一.把下面函数放到Ft_admin_conn.asp的最后 '================================== '=函 数 名:saveimgfile '=

保存远程图片到本地服务器几种方法[php,asp]

function get_file($url,$folder){    set_time_limit (24 * 60 * 60);       $destination_folder = $folder?$folder.'/':'';//文件下载保存目录            $newfname = $destination_folder . basename($url);    $file = fopen ($url, "rb");    if ($file) {    $newf