asp下实现替换远程文件为本地文件并保存远程文件的代码

1、将下面的文本文件下载,并将.txt改为remote.asp,里面有具体设置方法

<% 
'添加资源时是否保存远程图片
const ssavefileselect=true

'远程图片保存目录,结尾请不要加“/”
const ssavefilepath="/images/news"

'远程图片保存类型
const sfileext="jpg|gif|bmp|png"

'/////////////////////////////////////////////////////
'作 用：替换字符串中的远程文件为本地文件并保存远程文件
'参 数：
'     shtml        : 要替换的字符串
'     ssavepath    : 保存文件的路径
'     sext         : 执行替换的扩展名
function replaceremoteurl(shtml, ssavefilepath, sfileext)
    dim s_content
    s_content = shtml
    if isobjinstalled("microsoft.xmlhttp") = false then
        replaceremoteurl = s_content
        exit function
    end if

    dim re, remotefile, remotefileurl,savefilename,savefiletype,arrsavefilenames,arrsavefilename,ssavefilepaths
    set re = new regexp
    re.ignorecase = true
    re.global = true
    re.pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\s*\/)((\s)+[.]{1}(" & sfileext & ")))"
    set remotefile = re.execute(s_content)
    for each remotefileurl in remotefile
        savefiletype = replace(replace(remotefileurl,"/", "a"), ":", "a")
        arrsavefilename = right(savefiletype,12)
        ssavefilepaths=ssavefilepath & "/"
        savefilename = ssavefilepaths & arrsavefilename
        call saveremotefile(savefilename, remotefileurl)
        s_content = replace(s_content,remotefileurl,savefilename)
    next
    replaceremoteurl = s_content
end function

'////////////////////////////////////////
'作 用：保存远程的文件到本地
'参 数：localfilename ------ 本地文件名
'       remotefileurl ------ 远程文件url
'返回值：true ----成功
'        false ----失败
sub saveremotefile(s_localfilename,s_remotefileurl)
    dim ads, retrieval, getremotedata
    on error resume next
    set retrieval = server.createobject("microsoft.xmlhttp")
    with retrieval
        .open "get", s_remotefileurl, false, "", ""
        .send
        getremotedata = .responsebody
    end with
    set retrieval = nothing
    set ads = server.createobject("adodb.stream")
    with ads
        .type = 1
        .open
        .write getremotedata
        .savetofile server.mappath(s_localfilename), 2
        .cancel()
        .close()
    end with
    set ads=nothing
end sub

'////////////////////////////////////////
'作 用：检查组件是否已经安装
'参 数：strclassstring ----组件名
'返回值：true ----已经安装
'     false ----没有安装
function isobjinstalled(s_classstring)
    on error resume next
    isobjinstalled = false
    err = 0
    dim xtestobj
    set xtestobj = server.createobject(s_classstring)
    if 0 = err then isobjinstalled = true
    set xtestobj = nothing
    err = 0
end function
%>

2、调用方法:
<!--#include file="remote.asp"--> 

文章入库的地方改成下面的代码 

if ssavefileselect=true then  
     rs("content")=replaceremoteurl(articlecontent,ssavefilepath,sfileext)  
    else  
     rs("content")=articlecontent  
end if