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
如对本文有疑问，
点击进行留言回复！！
我要评论
网友评论