【下载文档:  newasp中下载类.txt 】

---

newasp中下载类
复制代码 代码如下:<% '================================================ ' 函数名：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 %>