gusucode.com > CRM源码带手机版ASP源码程序 > Skin/Default/TQEditor/upload.asp

    <!--#include file="UpLoad_Class.asp"-->
<%
'------------------------------------------------------
Dim oUpLoadType, oAction, oFileExe, ooFileSize, oFileSize, UpLoadFile
'------------------------------------------------------
Response.Buffer = True
Response.ExpiresAbsolute = Now() -1
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.Charset = "GB2312"
'------------------------------------------------------
oUpLoadType = Trim(Request("oUpLoadType"))
'------------------------------------------------------
Select Case oUpLoadType
    '------------------------------------------- 图片
    Case "Images"
        oFileExe = "jpg|jpeg|gif|bmp|swf|png"
        sFileSize = 2048
        UpLoadFile = oCreateFolder("../../../UpLoad/"&year(now())&"/Images/")
	'------------------------------------------- 图片
    Case "Img"
        oFileExe = "jpg|jpeg|gif|bmp|png"
        sFileSize = 2048
        UpLoadFile = oCreateFolder("/UpLoadPic/Img/")
    '------------------------------------------- 广告图片
    Case "Ad"
        oFileExe = "jpg|jpeg|gif|bmp|swf|png"
        sFileSize = 500
        UpLoadFile = oCreateFolder("/UpLoadPic/Ad/")
    '------------------------------------------- Flash
    Case "Flash"
        oFileExe = "swf|flv"
        sFileSize = 10240
        UpLoadFile = oCreateFolder("/UpLoadPic/Flash/")
    '------------------------------------------- 音乐
    Case "Music"
        oFileExe = "mp3"
        sFileSize = 10240
        UpLoadFile = oCreateFolder("/UpLoadFile/Music/")
    '------------------------------------------- 视频
    Case "Video"
        oFileExe = "wmv"
        sFileSize = 51200
        UpLoadFile = oCreateFolder("/UpLoadFile/Video/")
    '------------------------------------------- 连接
    Case "Link"
        oFileExe = "*"
        sFileSize = 51200
        UpLoadFile = oCreateFolder("/UpLoadFile/Link/")
    '------------------------------------------- 文件
	Case "UFile"
        oFileExe = "rar|zip|7z|tar|exe"
        sFileSize = 51200
        UpLoadFile = oCreateFolder("/UpLoadFile/UFile/")
    '------------------------------------------- 其它
    Case Else
        oFileExe = "jpg|gif|swf|png|rar|zip|7z"
        sFileSize = 2048
        UpLoadFile = oCreateFolder("/UpLoadPic/Others/")
End Select
oFileSize = 1024 * sFileSize

oUpLoad()

Sub oUpLoad()
    Dim Upload, sPath, tempCls, fName, UpLoadFileName, sSmallPath
    '===============================================================================
    Set Upload = New AnUpLoad                     '创建类实例
    Upload.IsNum = 1                              '设置随即的样式
    Upload.IsNumIng = 12                          '设置随即值,建议使用18位以上
    Upload.SingleSize = oFileSize                 '设置单个文件最大上传限制,按字节计；默认为不限制
    Upload.MaxSize = 1024 * 1024 * 1024           '设置最大上传限制,按字节计；默认为不限制
    Upload.Exe = oFileExe                         '设置合法扩展名,以|分割,忽略大小写
    Upload.Charset = "gb2312"                     '设置文本编码，默认为gb2312
    Upload.openProcesser = False                  '禁止进度条功能，如果启用，需配合客户端程序
    Upload.GetData()                              '获取并保存数据,必须调用本方法
    '===============================================================================
    If Upload.ErrorID>0 Then                      '判断错误号,如果myupload.Err<=0表示正常
        Response.Write Upload.Description         '如果出现错误,获取错误描述
        Response.End()
    Else
        If Upload.Files( -1).Count > 0 Then       '这里判断你是否选择了文件
            sPath = Server.MapPath(UpLoadFile)    '文件保存路径
            Set tempCls = Upload.Files("file")
            tempCls.SaveToFile sPath, 0
            fName = tempCls.FileName
            Set tempCls = Nothing
			UpLoadFileName = UpLoadFile&fName
			Response.Write("{url:'"&UpLoadFileName&"',  error:'0',message:'上传成功,请勿修改上传后的路径!', width:'宽度',height:'高度'}")
			Response.End()
        Else
            Response.Write("{url:'',  error:'1',message:'上传失败,您没有上传任何文件!', width:'宽度',height:'高度'}")
            Response.End()
        End If
    End If
    Set Upload = Nothing
End Sub
'================================================
'函数名：oCreateFolder
'作  用：创建多级目录，可以创建不存在的根目录
'参  数：sPath为绝对路径
'================================================
Function oCreateFolder(ByVal sPath)
	On Error Resume Next
    Dim IsPath
    IsPath = sPath
    sPath = Replace(sPath, "/", "\")
    sPath = Replace(sPath, "\\", "\")
    Dim strHostPath, strPath
    Dim sPathItem, sTempPath
    Dim i
    Set Fso = Server.CreateObject("Scripting.FileSystemObject")
    strHostPath = Server.MapPath("/")
    If InStr(sPath, ":") = 0 Then sPath = Server.MapPath(sPath)
    If Fso.FolderExists(sPath) Or Len(sPath) < 3 Then
        oCreateFolder = IsPath
        Exit Function
    End If
    strPath = Replace(sPath, strHostPath, vbNullString, 1, -1, 1)
    sPathItem = Split(strPath, "\")
    If InStr(LCase(sPath), LCase(strHostPath)) = 0 Then
        sTempPath = sPathItem(0)
    Else
        sTempPath = strHostPath
    End If
    For i = 1 To UBound(sPathItem)
        If sPathItem(i) <> "" Then
            sTempPath = sTempPath & "\" & sPathItem(i)
            If Fso.FolderExists(sTempPath) = False Then
                Fso.CreateFolder sTempPath
            End If
        End If
    Next
    If Err.Number <> 0 Then Err.Clear
    oCreateFolder = IsPath
End Function
'===============================================
'函数名：IsObjInstalled
'作  用：检测组件
'参  数：strClassString = 组件名
'返回值：True/False
'===============================================
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = Server.CreateObject(strClassString)
    If 0 = Err Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function
%>