<% '================================================ ' 函数名：SaveRemoteFile ' 作  用：保存远程文件到本地 ' 参  数：strFileName ----保存文件的名称 '         strRemoteUrl ----远程文件URL ' 返回值：布尔值 True/False '================================================ Function SaveRemoteFile(ByVal strFileName, ByVal strRemoteUrl)     Dim oStream, Retrieval, GetRemoteData     SaveRemoteFile = False     On Error Resume Next     Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")     Retrieval.Open "GET", strRemoteUrl, False, "", ""     Retrieval.Send     If Retrieval.readyState <> 4 Then Exit Function     If Retrieval.Status > 300 Then Exit Function     GetRemoteData = Retrieval.ResponseBody     Set Retrieval = Nothing     If LenB(GetRemoteData) > 100 Then         Set oStream = Server.CreateObject("Adodb.Stream")         oStream.Type = 1         oStream.Mode = 3         oStream.Open         oStream.Write GetRemoteData         oStream.SaveToFile Server.MapPath(strFileName), 2         oStream.Cancel         oStream.Close         Set oStream = Nothing     Else         Exit Function     End If     If Err.Number = 0 Then         SaveRemoteFile = True     Else         Err.Clear     End If End Function %>

<% Class Download_Cls     Private sUploadDir     Private nAllowSize     Private sAllowExt     Private sOriginalFileName     Private sSaveFileName     Private sPathFileName     Public Property Get RemoteFileName()         RemoteFileName = sOriginalFileName     End Property     Public Property Get LocalFileName()         LocalFileName = sSaveFileName     End Property     Public Property Get LocalFilePath()         LocalFilePath = sPathFileName     End Property     Public Property Let RemoteDir(ByVal strDir)         sUploadDir = strDir     End Property     Public Property Let AllowMaxSize(ByVal intSize)         nAllowSize = intSize     End Property     Public Property Let AllowExtName(ByVal strExt)         sAllowExt = strExt     End Property     Private Sub Class_Initialize()         On Error Resume Next         Script_Object = "Scripting.FileSystemObject"         sUploadDir = "UploadFile/"         nAllowSize = 500         sAllowExt = "gif|jpg|png|bmp"     End Sub     Public Function ChangeRemote(sHTML)         On Error Resume Next         Dim s_Content         s_Content = sHTML         On Error Resume Next         Dim re, s, RemoteFileUrl, SaveFileName, SaveFileType         Set re = New RegExp         re.IgnoreCase = True         re.Global = True         re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sAllowExt & ")))"         Set s = re.Execute(s_Content)         Dim a_RemoteUrl(), n, i, bRepeat         n = 0         ' 转入无重复数据         For Each RemoteFileUrl In s             If n = 0 Then                 n = n + 1                 ReDim a_RemoteUrl(n)                 a_RemoteUrl(n) = RemoteFileUrl             Else                 bRepeat = False                 For i = 1 To UBound(a_RemoteUrl)                     If UCase(RemoteFileUrl) = UCase(a_RemoteUrl(i)) Then                         bRepeat = True                         Exit For                     End If                 Next                 If bRepeat = False Then                     n = n + 1                     ReDim Preserve a_RemoteUrl(n)                     a_RemoteUrl(n) = RemoteFileUrl                 End If             End If         Next         ' 开始替换操作         Dim nFileNum, sContentPath,strFilePath         sContentPath = RelativePath2RootPath(sUploadDir)         nFileNum = 0         For i = 1 To n             SaveFileType = Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), ".") + 1)             SaveFileName = GetRndFileName(SaveFileType)             strFilePath = sUploadDir & SaveFileName             If SaveRemoteFile(strFilePath, a_RemoteUrl(i)) = True Then                 nFileNum = nFileNum + 1                 If nFileNum > 0 Then                     sOriginalFileName = sOriginalFileName & "|"                     sSaveFileName = sSaveFileName & "|"                     sPathFileName = sPathFileName & "|"                 End If                 sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), "/") + 1)                 sSaveFileName = sSaveFileName & SaveFileName                 sPathFileName = sPathFileName & sContentPath & SaveFileName                 s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)             End If         Next         ChangeRemote = s_Content     End Function     Public Function RelativePath2RootPath(url) '这个主要是实现../转换为实际路径         Dim sTempUrl         sTempUrl = url         If Left(sTempUrl, 1) = "/" Then             RelativePath2RootPath = sTempUrl             Exit Function         End If         Dim sWebEditorPath         sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")         sWebEditorPath = Left(sWebEditorPath, InStrRev(sWebEditorPath, "/") - 1)         Do While Left(sTempUrl, 3) = "../"             sTempUrl = Mid(sTempUrl, 4)             sWebEditorPath = Left(sWebEditorPath, InStrRev(sWebEditorPath, "/") - 1)         Loop         RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl     End Function     Public Function GetRndFileName(sExt)         Dim sRnd         Randomize         sRnd = Int(900 * Rnd) + 100         GetRndFileName = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & sRnd & "." & sExt     End Function End Class %>