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