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