代码如下:

<%

'添加资源时是否保存远程图片

ConstsSaveFileSelect=True

'远程图片保存目录,结尾请不要加“/”

ConstsSaveFilePath="/images/News"

'远程图片保存类型

ConstsFileExt="jpg|gif|bmp|png"

'/////////////////////////////////////////////////////

'作用：替换字符串中的远程文件为本地文件并保存远程文件

'参数：

'sHTML:要替换的字符串

'sSavePath:保存文件的路径

'sExt:执行替换的扩展名

FunctionReplaceRemoteUrl(sHTML,sSaveFilePath,sFileExt)

Dims_Content

s_Content=sHTML

IfIsObjInstalled("Microsoft.XMLHTTP")=Falsethen

ReplaceRemoteUrl=s_Content

ExitFunction

EndIf

Dimre,RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,sSaveFilePaths

Setre=newRegExp

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&")))"

SetRemoteFile=re.Execute(s_Content)

ForEachRemoteFileurlinRemoteFile

SaveFileType=Replace(Replace(RemoteFileurl,"/","a"),":","a")

arrSaveFileName=Right(SaveFileType,12)

sSaveFilePaths=sSaveFilePath&"/"

SaveFileName=sSaveFilePaths&arrSaveFileName

CallSaveRemoteFile(SaveFileName,RemoteFileurl)

s_Content=Replace(s_Content,RemoteFileurl,SaveFileName)

Next

ReplaceRemoteUrl=s_Content

EndFunction

'////////////////////////////////////////

'作用：保存远程的文件到本地

'参数：LocalFileName------本地文件名

'RemoteFileUrl------远程文件URL

'返回值：True----成功

'False----失败

SubSaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)

DimAds,Retrieval,GetRemoteData

OnErrorResumeNext

SetRetrieval=Server.CreateObject("Microsoft.XMLHTTP")

WithRetrieval

.Open"Get",s_RemoteFileUrl,False,"",""

.Send

GetRemoteData=.ResponseBody

EndWith

SetRetrieval=Nothing

SetAds=Server.CreateObject("Adodb.Stream")

WithAds

.Type=1

.Open

.WriteGetRemoteData

.SaveToFileServer.MapPath(s_LocalFileName),2

.Cancel()

.Close()

EndWith

SetAds=nothing

EndSub

'////////////////////////////////////////

'作用：检查组件是否已经安装

'参数：strClassString----组件名

'返回值：True----已经安装

'False----没有安装

FunctionIsObjInstalled(s_ClassString)

OnErrorResumeNext

IsObjInstalled=False

Err=0

DimxTestObj

SetxTestObj=Server.CreateObject(s_ClassString)

If0=ErrThenIsObjInstalled=True

SetxTestObj=Nothing

Err=0

EndFunction

%>

2、调用方法:

<!--#includefile="remote.asp"-->

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

代码如下:

IfsSaveFileSelect=TrueThen

Rs("Content")=ReplaceRemoteUrl(ArticleContent,sSaveFilePath,sFileExt)

Else

Rs("Content")=ArticleContent

EndIf

下一篇：asp从字符串里截取N个带HTML的字符的函数