powereasy.upfile.asp

个人网站比较简短

<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Const MaxTotalSize = 104857600    '上传数据限制，最大上传100M
Const NoAllowExt = "asa|asax|ascs|ashx|asmx|asp|aspx|axd|cdx|cer|config|cs|csproj|idc|licx|rem|resources|resx|shtm|shtml|soap|stm|vb|vbproj|vsdisco|webinfo"    '不允许上传类型(黑名单)
Const NeedCheckFileMimeExt = "gif|jpg|jpeg|jpe|bmp|png|swf|mid|mp3|wmv|asf|avi|mpg|ram|rm|ra|rar|exe|doc|zip"
Dim uEnableUpload, uMaxFileSize, AdminLogined

Sub Execute()
    If ObjInstalled_FSO = False Then
        Response.Write "您的服务器不支持FSO，或者FSO已经改名，所以不能上传！"
        Exit Sub
    End If
    
    If CheckLogin() = False Then
        Response.Write "请先登录！"
        Exit Sub
    End If
    
    Dim Forms, Files
    Dim oUpFilestream   '上传的数据流
    
    '********************************************
    '以下代码是对提交的数据进行分析
    '********************************************
    Dim RequestBinDate, sSpace, bCrLf, sInfo, iInfoStart, iInfoEnd, tStream, iStart
    Dim sFormValue, sFileName
    Dim iFindStart, iFindEnd
    Dim iFormstart, iFormEnd, sFormName
    Dim FileInfo(6)
        '代码开始
    If Request.TotalBytes < 1 Then  '如果没有数据上传
        FoundErr = True
        ErrMsg = "没有数据上传"
        Exit Sub
    End If
        
    If Request.TotalBytes > MaxTotalSize Then  '如果上传的数据超出限制大小
        FoundErr = True
        ErrMsg = "上传的数据超出限制大小"
        Exit Sub
    End If
        
    Set Forms = Server.CreateObject("Scripting.Dictionary")
    Forms.CompareMode = 1
    Set Files = Server.CreateObject("Scripting.Dictionary")
    Files.CompareMode = 1
    Set tStream = Server.CreateObject("ADODB.Stream")
    Set oUpFilestream = Server.CreateObject("ADODB.Stream")
    oUpFilestream.Type = 1
    oUpFilestream.Mode = 3
    oUpFilestream.Open
    oUpFilestream.Write Request.BinaryRead(Request.TotalBytes)
    oUpFilestream.Position = 0
    RequestBinDate = oUpFilestream.Read
    iFormEnd = oUpFilestream.size
    bCrLf = ChrB(13) & ChrB(10)
    '取得每个项目之间的分隔符
    sSpace = LeftB(RequestBinDate, InStrB(1, RequestBinDate, bCrLf) - 1)
    iStart = LenB(sSpace)
    iFormstart = iStart + 2
    '分解项目
    
    Do
        iInfoEnd = InStrB(iFormstart, RequestBinDate, bCrLf & bCrLf) + 3
        tStream.Type = 1
        tStream.Mode = 3
        tStream.Open
        oUpFilestream.Position = iFormstart
        oUpFilestream.CopyTo tStream, iInfoEnd - iFormstart
        tStream.Position = 0
        tStream.Type = 2
        tStream.Charset = "gb2312"
        sInfo = tStream.ReadText
                
        '取得表单项目名称
        iFindStart = InStr(22, sInfo, "name=""", 1) + 6
        iFindEnd = InStr(iFindStart, sInfo, """", 1)
        sFormName = Mid(sInfo, iFindStart, iFindEnd - iFindStart)
            
        iFormstart = InStrB(iInfoEnd, RequestBinDate, sSpace) - 1
        If InStr(45, sInfo, "filename=""", 1) > 0 Then   '如果是文件
            '取得文件属性
            iFindStart = InStr(iFindEnd, sInfo, "filename=""", 1) + 10
            iFindEnd = InStr(iFindStart, sInfo, """" & vbCrLf, 1)
            sFileName = Mid(sInfo, iFindStart, iFindEnd - iFindStart)
            FileInfo(0) = sFormName
            FileInfo(1) = GetFileName(sFileName)
            FileInfo(2) = GetFilePath(sFileName)
            FileInfo(3) = GetFileExt(sFileName)
            iFindStart = InStr(iFindEnd, sInfo, "Content-Type: ", 1) + 14
            iFindEnd = InStr(iFindStart, sInfo, vbCr)
            FileInfo(4) = Mid(sInfo, iFindStart, iFindEnd - iFindStart)
            FileInfo(5) = iInfoEnd
            FileInfo(6) = iFormstart - iInfoEnd - 2
            Files.Add sFormName, FileInfo
        Else    '如果是表单项目
            tStream.Close
            tStream.Type = 1
            tStream.Mode = 3
            tStream.Open
            oUpFilestream.Position = iInfoEnd
            oUpFilestream.CopyTo tStream, iFormstart - iInfoEnd - 2
            tStream.Position = 0
            tStream.Type = 2
            tStream.Charset = "gb2312"
            sFormValue = tStream.ReadText
            If Forms.Exists(sFormName) Then
                Forms(sFormName) = Forms(sFormName) & ", " & sFormValue
            Else
                Forms.Add sFormName, sFormValue
            End If
        End If
        tStream.Close
        iFormstart = iFormstart + iStart + 2
        '如果到文件尾了就退出
    Loop Until (iFormstart + 2) >= iFormEnd
    RequestBinDate = ""
    Set tStream = Nothing
    '********************************************
    '数据分析结束
    '********************************************
    
    Dim EnableUploadFile, MaxFileSize, UpFileType, SavePath, dirMonth, tmpPath
    If fso.FolderExists(Server.MapPath(InstallDir)) = False Then fso.CreateFolder Server.MapPath(InstallDir)
        
    Dim FileType, Uname, checkuserrs, MaxSpaceSize
    FileType = LCase(Trim(Forms("FileType")))
    MaxSpaceSize = PE_CLng(Trim(Forms("size")))
    Dim ChannelID, sqlChannel, rsChannel, UploadDir, ModuleType, IsThumb
    
    ChannelID = PE_CLng(Trim(Forms("ChannelID")))
    If ChannelID = 0 Then
        EnableUploadFile = True
        Select Case FileType
        Case "authorpic", "copyfrompic"
            If AdminLogined <> True Then
                Response.Write "请先登录！"
                Exit Sub
            End If
            UploadDir = FileType & "/"
            SavePath = InstallDir & UploadDir
            UpFileType = "gif|jpg|jpeg|jpe|bmp|png|swf"
            MaxFileSize = 2048
            If fso.FolderExists(Server.MapPath(InstallDir & FileType)) = False Then fso.CreateFolder Server.MapPath(InstallDir & FileType)
        Case "producerpic", "trademarkpic"
            If AdminLogined <> True Then
                Response.Write "请先登录！"
                Exit Sub
            End If
            UploadDir = "Shop/" & FileType & "/"
            SavePath = InstallDir & UploadDir
            UpFileType = "gif|jpg|jpeg|jpe|bmp|png|swf"
            MaxFileSize = 2048
            If fso.FolderExists(Server.MapPath(SavePath)) = False Then fso.CreateFolder Server.MapPath(SavePath)
        Case "adminblogpic"
            If AdminLogined <> True Then
                Response.Write "请先登录！"
                Exit Sub
            End If
            Uname = ReplaceBadChar(Trim(Forms("Uname")))
            Set checkuserrs = Conn.Execute("select UserID,UserName from PE_User where UserName='" & Uname & "'")
            If checkuserrs.BOF And checkuserrs.EOF Then
                Response.Write "用户验证错"
                checkuserrs.Close
                Set checkuserrs = Nothing
                Exit Sub
            Else
                UploadDir = "Space/" & Uname & checkuserrs("UserID") & "/"
                checkuserrs.Close
                Set checkuserrs = Nothing
                SavePath = InstallDir & UploadDir
                UpFileType = "gif|jpg|jpeg|jpe|bmp|png|swf"
                MaxFileSize = 2048
                If fso.FolderExists(Server.MapPath(SavePath)) = False Then fso.CreateFolder Server.MapPath(SavePath)
            End If
        Case "userblogpic"
            uEnableUpload = True
            Set checkuserrs = Conn.Execute("select UserID,UserName from PE_User where UserName='" & UserName & "'")
            If checkuserrs.BOF And checkuserrs.EOF Then
                Response.Write "用户验证错"
                checkuserrs.Close
                Set checkuserrs = Nothing
                Exit Sub
            Else
                UploadDir = "Space/" & UserName & checkuserrs("UserID") & "/"
                checkuserrs.Close
                Set checkuserrs = Nothing
                SavePath = InstallDir & UploadDir
                UpFileType = "gif|jpg|jpeg|jpe|bmp|png"
                MaxFileSize = 2048
                If fso.FolderExists(Server.MapPath(SavePath)) = False Then fso.CreateFolder Server.MapPath(SavePath)
                Dim ft, foldersize, realsize
                Set ft = fso.GetFolder(Server.MapPath(SavePath))
                foldersize = ft.size
                If foldersize = 0 Then foldersize = 1
                realsize = foldersize / 1048576
                If realsize > MaxSpaceSize Then
                    Response.Write "您的空间已满,请清理后再上传！"
                    Exit Sub
            End If
                Set ft = Nothing
            End If
        Case "Intervieweepic" '上传简历相片2006-1-13
            uEnableUpload = True
            UploadDir = "UploadPhoto/"
            SavePath = InstallDir & UploadDir
            UpFileType = "gif|jpg|jpeg|jpe|bmp|png"
            MaxFileSize = 2048
            If fso.FolderExists(Server.MapPath(InstallDir & "UploadPhoto")) = False Then fso.CreateFolder Server.MapPath(InstallDir & "UploadPhoto")
        Case "adpic"
            SavePath = InstallDir & ADDir & "/UploadADPic/"
            UpFileType = "gif|jpg|jpeg|jpe|bmp|png|swf"
            MaxFileSize = 2048
            If fso.FolderExists(Server.MapPath(SavePath)) = False Then fso.CreateFolder Server.MapPath(SavePath)
        Case Else
            Response.Write "频道参数丢失！"
            Exit Sub
        End Select
    Else
        sqlChannel = "select ChannelID,ChannelName,ChannelDir,ModuleType,Disabled,EnableUploadFile,UploadDir,MaxFileSize,UpFileType from PE_Channel where ChannelID=" & ChannelID
        Set rsChannel = Server.CreateObject("adodb.recordset")
        rsChannel.Open sqlChannel, Conn, 1, 1
        If rsChannel.BOF And rsChannel.EOF Then
            Response.Write "找不到此频道"
            FoundErr = True
            rsChannel.Close
            Set rsChannel = Nothing
            Exit Sub
        End If
        If rsChannel("Disabled") = True Then
            Response.Write "此频道已经被禁用！"
            FoundErr = True
        Else
            EnableUploadFile = rsChannel("EnableUploadFile")
            MaxFileSize = rsChannel("MaxFileSize")
            UpFileType = rsChannel("UpFileType")
            Dim arrFileType
            If UpFileType = "" Then
                arrFileType = Split("gif|jpg|jpeg|jpe|bmp|png$swf$mid|mp3|wmv|asf|avi|mpg$ram|rm|ra$rar|exe|doc|zip", "$")
            Else
                arrFileType = Split(UpFileType, "$")
                If UBound(arrFileType) < 4 Then
                    arrFileType = Split("gif|jpg|jpeg|jpe|bmp|png$swf$mid|mp3|wmv|asf|avi|mpg$ram|rm|ra$rar|exe|doc|zip", "$")
                End If
            End If
            ModuleType = rsChannel("ModuleType")
            Select Case ModuleType
            Case 0, 1, 3, 4, 5, 6, 7, 8 '2006-1-13
                UploadDir = rsChannel("UploadDir") & "/"
            Case 2
                If FileType = "softpic" Or FileType = "pic" Then '软件简介图片上传
                    UploadDir = "UploadSoftPic/"
                Else
                    UploadDir = rsChannel("UploadDir") & "/"
                End If
            End Select