蝙蝠岛资源网 Design By www.hbtsch.com
复制代码 代码如下:
<%
'================================================
' 函数名: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
%>
标签:
newasp中下载类

蝙蝠岛资源网 Design By www.hbtsch.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
蝙蝠岛资源网 Design By www.hbtsch.com

评论“newasp中下载类”

暂无newasp中下载类的评论...

稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!

昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。

这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。

而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?