欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2023-12-03 11:37:10
1、将下面的文本文件下载,并将.txt改为remote.asp,里面有具体设置方法 复制代码 代码如下:<%  '添加资源时是否保存远程图片 const&n...
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