<%
'#################################################################################
'##	easp.molibupload.asp
'##	------------------------------------------------------------------------------
'##	Feature		:	EasyAsp MoLibUpload Plugin
'##	Version		:	V1.1
'##	Author		:	艾恩(http://dev.mo.cn)
'## Update      :   苏家戏子(939881475[at]qq.com)
'##	Update Date	:	2013/3/4 10:33
'##	Description	:	艾恩Asp无组件上传-MoLibUpload V1.1 For EasyAasp (Plugin)
'#################################################################################

Class EasyAsp_MoLibUpload
    Private Form, Fils, StreamT, mvarClsName, mvarClsDescription, mvarSavePath, mvarCheckImageFormat
    Private vCharSet, vMaxSize, vSingleSize, vErr, vVersion, vTotalSize
    Private vExe, vErrExe, vboundary, vLostTime, vFileCount, StreamOpened
    Private vMuti, vServerVersion, mvarDescription

    Public Property Let AllowMaxSize(ByVal Value)
        vMaxSize = Value
    End Property

    Public Property Let AllowMaxFileSize(ByVal Value)
        vSingleSize = Value
    End Property

    Public Property Let AllowFileTypes(ByVal Value)
        vExe = LCase(Value)
        vExe = Replace(vExe, "*.", "")
        vExe = Replace(vExe, ";", "|")
    End Property

    Public Property Let CheckImageFormat(byval Value)
        mvarCheckImageFormat = Value
    End Property


    Public Property Let CharSet(ByVal Value)
        vCharSet = Value
    End Property

    Public Property Let SavePath(ByVal Value)
        mvarSavePath = Value
    End Property

    Public Property Get FileCount()
        FileCount = Fils.Count
    End Property

    Public Property Get Description()
        Description = mvarDescription
    End Property

    Public Property Get Version()
        Version = vVersion
    End Property

    Public Property Get TotalSize()
        TotalSize = vTotalSize
    End Property

    Public Property Get LostTime()
        LostTime = vLostTime
    End Property

    Private Sub Class_Initialize()
        Dim T__
        Set Form = Server.CreateObject("Scripting.Dictionary")
        Set Fils = Server.CreateObject("Scripting.Dictionary")
        Set StreamT = Server.CreateObject("Adodb.stream")
        vVersion = "MoLibUpload V1.1"
        vMaxSize = -1
        vSingleSize = -1
        vErr = -1
        vExe = ""
        vTotalSize = 0
        vCharSet = "utf-8"
        StreamOpened = False
        vMuti = "_" & GetName() & "_"
        mvarCheckImageFormat = False
        vServerVersion = 6.0
        T__ = LCase(Request.ServerVariables("SERVER_SOFTWARE"))
        T__ = Replace(T__, "microsoft-iis/", "")
        If IsNumeric(T__) Then vServerVersion = CDbl(T__)
        mvarClsName = "MoLibFileExtern_" + GetName()
        mvarClsDescription = "Class {ClsName}\nPublic ContentType,Size,UserSetName,Path,Position,FormName,TempFormName, NewName,FileName,LocalName,IsFile,Extend,Succeed,Exception,Width,Height,IsImage\nEnd Class"
        mvarClsDescription = Replace(mvarClsDescription, "{ClsName}", mvarClsName)
        mvarClsDescription = Replace(mvarClsDescription, "\n", vbCrLf)
        ExecuteGlobal mvarClsDescription
    End Sub

    Private Sub Class_Terminate()
        Dim f
        Form.RemoveAll()
        For Each f in Fils
            Set Fils(f) = Nothing
        Next
        Fils.RemoveAll()
        Set Form = Nothing
        Set Fils = Nothing
        If StreamOpened Then StreamT.Close()
        Set StreamT = Nothing
    End Sub

    Private Function ParseSizeLimit(byval SizeLimit)
        Dim unit, Value, multiplier, limit
        If Not IsNumeric(SizeLimit) Then
            multiplier = 1
            SizeLimit = ReplaceEx(LCase(SizeLimit), "\s", "")
            Value = replaceex(SizeLimit, "[^\d]+", "")
            If IsNumeric(Value) Then
                Value = CLng(Value)
                If Right(SizeLimit, 2) = "gb" Then multiplier = 1073741824
                If Right(SizeLimit, 2) = "mb" Then multiplier = 1048576
                If Right(SizeLimit, 2) = "kb" Then multiplier = 1024
                limit = Value * multiplier
            Else
                limit = -1
            End If
        Else
            limit = SizeLimit
        End If
        If limit< -1 Then limit = -1
        ParseSizeLimit = limit
    End Function

    Public Function GetData()
        GetData = False
        vMaxSize = ParseSizeLimit(vMaxSize)
        vSingleSize = ParseSizeLimit(vSingleSize)
        Dim time1
        time1 = Timer()
        Dim Value, Str, bcrlf, fpos, sSplit, slen, istart, ef
        Dim TotalBytes, tempdata, BytesRead, ChunkReadSize, PartSize, DataPart, formend, formhead
        Dim startpos, endpos, formname, FileName, fileExe, valueend, NewName, localname, type_1, contentType
        TotalBytes = Request.TotalBytes
        ef = False
        If checkEntryType = False Then ef = True
        mvarDescription = "无效的EncTypeor方法"
        If vServerVersion>= 6 Then
            If Not ef Then
                If vMaxSize > 0 And TotalBytes > vMaxSize Then ef = True
                mvarDescription = "错误的文件超过最大大小限制"
            End If
        End If
        If ef Then Exit Function
        vTotalSize = 0
        StreamT.Type = 1
        StreamT.Mode = 3
        StreamT.Open
        StreamOpened = True
        BytesRead = 0
        ChunkReadSize = 1024 * 16
        Do While BytesRead < TotalBytes
            PartSize = ChunkReadSize
            If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
            DataPart = Request.BinaryRead(PartSize)
            StreamT.Write DataPart
            BytesRead = BytesRead + PartSize
        Loop
        StreamT.Position = 0
        tempdata = StreamT.Read
        bcrlf = ChrB(13) & ChrB(10)
        fpos = InStrB(1, tempdata, bcrlf)
        sSplit = MidB(tempdata, 1, fpos - 1)
        slen = LenB(sSplit)
        istart = slen + 2
        Do
            formend = InStrB(istart, tempdata, bcrlf & bcrlf)
            If formend<= 0 Then Exit Do
            formhead = MidB(tempdata, istart, formend - istart)
            Str = Bytes2Str(formhead)
            startpos = InStr(Str, "name=""") + 6
            If startpos<= 0 Then Exit Do
            endpos = InStr(startpos, Str, """")
            If endpos<= 0 Then Exit Do
            formname = LCase(Mid(Str, startpos, endpos - startpos))
            valueend = InStrB(formend + 3, tempdata, sSplit)
            If valueend<= 0 Then Exit Do
            If InStr(Str, "filename=""") > 0 Then
                formname = formname & vMuti & "0"
                startpos = InStr(Str, "filename=""") + 10
                endpos = InStr(startpos, Str, """")
                type_1 = InStr(endpos, LCase(Str), "content-type")
                contentType = LCase(Trim(Mid(Str, type_1 + 13)))
                FileName = Mid(Str, startpos, endpos - startpos)
                If Trim(FileName) <> "" Then
                    FileName = Replace(FileName, "/", "\")
                    FileName = Replace(FileName, Chr(0), "")
                    LocalName = FileName
                    FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
                    If InStr(FileName, ".")>0 Then
                        fileExe = Split(FileName, ".")(UBound(Split(FileName, ".")))
                    Else
                        fileExe = ""
                    End If
                    If vExe <> "" Then
                        If checkExe(fileExe) = True Then
                            mvarDescription = "无效的文件类型(." & UCase(fileExe) & ")"
                            vErrExe = fileExe
                            tempdata = Empty
                            Exit Function
                        End If
                    End If
                    NewName = GetName()
                    vTotalSize = vTotalSize + valueend - formend - 6
                    If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then
                        mvarDescription = "错误的文件超过大小限制"
                        tempdata = Empty
                        Exit Function
                    End If
                    If vMaxSize > 0 And vTotalSize > vMaxSize Then
                        mvarDescription = "错误的文件超过最大大小限制"
                        tempdata = Empty
                        Exit Function
                    End If
                    If Fils.Exists(formname) Then formname = GetNextFormName(formname)
                    fileExe = LCase(fileExe)
                    fileExe = Replace(fileExe, ";", "")
                    Dim fileCls
                    Set fileCls = NewFile()
                    fileCls.ContentType = contentType
                    fileCls.Size = (valueend - formend - 6)
                    fileCls.Position = (formend + 3)
                    fileCls.FormName = Mid(formname, InStr(formname, vMuti) -1)
                    fileCls.TempFormName = formname
                    fileCls.NewName = NewName & "." & fileExe
                    fileCls.FileName = FileName
                    fileCls.LocalName = FileName
                    fileCls.IsFile = True
                    fileCls.IsImage = False
                    fileCls.Extend = fileExe
                    If mvarCheckImageFormat = True Then
                        If InStr(",image/jpeg,image/pjpeg,image/jpg,image/gif,image/png,image/bmp,application/x-shockwave-flash,", "," & contentType & ",")>0 Or InStr(",jpg,jpeg,pjpeg,bmp,png,gif,swf,", "," & fileExe & ",")>0 Then
                            fileCls.IsImage = IsImage(fileCls)
                            If fileCls.IsImage Then fileCls.NewName = NewName & "." & fileCls.Extend
                        End If
                    End If
                    Fils.Add formname, fileCls
                End If
            Else
                Value = MidB(tempdata, formend + 4, valueend - formend - 6)
                If Form.Exists(formname) Then
                    Form(formname) = Form(formname) & "," & Bytes2Str(Value)
                Else
                    Form.Add formname, Bytes2Str(Value)
                End If
            End If
            istart = valueend + 2 + slen
        Loop Until (istart + 2) >= LenB(tempdata)
        tempdata = Empty
        vLostTime = FormatNumber((Timer - time1) * 1000, 2)
        GetData = True
    End Function

    Private Function CheckExe(ByVal ex)
        Dim notIn
        notIn = True
        If vExe = "*" Then
            notIn = False
        ElseIf InStr(1, vExe, "|") > 0 Then
            Dim tempExe
            tempExe = Split(vExe, "|")
            Dim I
            I = 0
            For I = 0 To UBound(tempExe)
                If LCase(ex) = tempExe(I) Then
                    notIn = False
                    Exit For
                End If
            Next
        Else
            If vExe = LCase(ex) Then
                notIn = False
            End If
        End If
        checkExe = notIn
    End Function

    Private Function Bytes2Str(ByVal byt)
        If LenB(byt) = 0 Then
            Bytes2Str = ""
            Exit Function
        End If
        Dim mystream, bstr
        Set mystream = Server.CreateObject("ADODB.Stream")
        mystream.Type = 2
        mystream.Mode = 3
        mystream.Open
        mystream.WriteText byt
        mystream.Position = 0
        mystream.CharSet = vCharSet
        mystream.Position = 2
        bstr = mystream.ReadText()
        mystream.Close
        Set mystream = Nothing
        Bytes2Str = bstr
    End Function

    Private Function GetName()
        Dim RndDateStr
        RndDateStr = Easp.DateTime(Now(), "hhiiss") & Easp.RandStr("10000-99999")
        GetName = RndDateStr
    End Function

    Private Function checkEntryType()
        Dim ContentType, ctArray, bArray, RequestMethod
        RequestMethod = Trim(LCase(Request.ServerVariables("REQUEST_METHOD")))
        If RequestMethod = "" Or RequestMethod<>"post" Then
            checkEntryType = False
            Exit Function
        End If
        ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE"))
        If ContentType = "" Then ContentType = LCase(Request.ServerVariables("CONTENT_TYPE"))
        ctArray = Split(ContentType, ";")
        If UBound(ctarray)>= 0 Then
            If Trim(ctArray(0)) = "multipart/form-data" Then
                checkEntryType = True
                vboundary = Split(ContentType, "boundary=")(1)
            Else
                checkEntryType = False
            End If
        Else
            checkEntryType = False
        End If
    End Function

    Public Function Post(ByVal formname)
        If Trim(formname) = "-1" Then
            Set Post = Form
        Else
            If Form.Exists(LCase(formname)) Then
                Post = Form(LCase(formname))
            Else
                Post = ""
            End If
        End If
    End Function

    Public Default Function Files(ByVal formname)
        If Trim(formname) = "-1" Then
            Set Files = Fils
        Else
            Dim vname
            vname = LCase(formname) & vMuti & "0"
            If InStr(formname, vMuti)>0 Then vname = formname
            If Fils.Exists(vname) Then
                Set Files = Fils(vname)
            Else
                Set Files = NewFile()
                Files.IsFile = False
            End If
        End If
    End Function

    Public Function Search(ByVal formname)
        If formname = "*" Or formname = "-1" Then
            Set Search = Fils
            Exit Function
        End If
        Dim TempFormName
        TempFormName = formname & vMuti
        Dim FileCollection
        Set FileCollection = Server.CreateObject("Scripting.Dictionary")
        Dim v
        For Each v In Fils
            If LCase(Left(v, Len(TempFormName))) = LCase(TempFormName) Then
                FileCollection.Add v, Fils(v)
            End If
        Next
        Set Search = FileCollection
    End Function

    Public Function QuickSave(ByVal formname)
        Dim FC, SucceedCount, File
        SucceedCount = 0
        Set FC = Search(formname)
        For Each File In FC
            If Save(File, 0, True).Succeed Then SucceedCount = SucceedCount + 1
        Next
        QuickSave = SucceedCount
    End Function

    Public Function IsImage(Name)
        Dim File
        If Not IsObject(Name) Then
            Set File = Files(Name)
            If Not File.IsFile Then
                IsImage = False
                Exit Function
            End If
        Else
            Set File = Name
        End If
        IsImage = False
        'from internet
        Dim intTemp, strTemp, isJpeg, ispng, a, b, c, d, tempContentType
        tempContentType = LCase(File.contentType)
        Select Case LCase(File.Extend)
            Case "jpg", "jpeg", "pjpeg"
                tempContentType = "image/jpeg"
            Case "gif"
                tempContentType = "image/gif"
            Case "png"
                tempContentType = "image/png"
            Case "bmp"
                tempContentType = "image/bmp"
            Case "swf"
                tempContentType = "application/x-shockwave-flash"
        End Select
        Select Case tempContentType
            Case "image/jpeg", "image/pjpeg", "image/jpg"
                If LCase(File.Extend)<>"jpg" Then File.Extend = "jpg"
                StreamT.Position = File.Position + 3
                Do While Not StreamT.EOS
                    Do
                        intTemp = Ascb(StreamT.Read(1))
                    Loop While intTemp = 255 And Not StreamT.EOS
                    If intTemp < 192 Or intTemp > 195 Then
                        StreamT.Read(Bin2Val(StreamT.Read(2)) -2)
                    Else
                        Exit Do
                    End If
                    Do
                        intTemp = Ascb(StreamT.Read(1))
                    Loop While intTemp < 255 And Not StreamT.EOS
                Loop
                StreamT.Read(3)
                File.Height = Bin2Val(StreamT.Read(2))
                File.Width = Bin2Val(StreamT.Read(2))
                StreamT.Position = File.Position + File.Size -2
                isJpeg = False
                If ascb(StreamT.Read(1)) = &HFF Then
                    If ascb(StreamT.Read(1)) = &HD9 Then
                        isJpeg = True
                    End If
                End If
                If Not isJpeg Then
                    File.Width = 0
                    File.Height = 0
                    File.Size = 0
                End If
            Case "image/gif"
                If LCase(File.Extend)<>"gif" Then File.Extend = "gif"
                StreamT.Position = File.Position + 6
                File.Width = BinVal2(StreamT.Read(2))
                File.Height = BinVal2(StreamT.Read(2))
                StreamT.Position = File.Position + File.Size -1
                If ascb(StreamT.Read(1)) <>Asc(";") Then
                    File.Width = 0
                    File.Height = 0
                    File.Size = 0
                End If
            Case "image/png"
                If LCase(File.Extend)<>"png" Then File.Extend = "png"
                StreamT.Position = File.Position + 18
                File.Width = Bin2Val(StreamT.Read(2))
                StreamT.Read(2)
                File.Height = Bin2Val(StreamT.Read(2))
                StreamT.Position = File.Position + File.Size -12
                ispng = False
                intTemp = Ascb(StreamT.Read(1))
                intTemp = intTemp + Ascb(StreamT.Read(1))
                intTemp = intTemp + Ascb(StreamT.Read(1))
                intTemp = intTemp + Ascb(StreamT.Read(1))
                If intTemp = 0 Then
                    a = Ascb(StreamT.Read(1))
                    b = Ascb(StreamT.Read(1))
                    c = Ascb(StreamT.Read(1))
                    d = Ascb(StreamT.Read(1))
                    If a = &H49 And b = &H45 And c = &H4e And d = &H44 Then
                        a = Ascb(StreamT.Read(1))
                        b = Ascb(StreamT.Read(1))
                        c = Ascb(StreamT.Read(1))
                        d = Ascb(StreamT.Read(1))
                        If a = &HAE And b = &H42 And c = &H60 And d = &H82 Then
                            ispng = True
                        End If
                    End If
                End If
                If Not ispng Then
                    File.Width = 0
                    File.Height = 0
                    File.Size = 0
                End If
            Case "image/bmp"
                If LCase(File.Extend)<>"bmp" Then File.Extend = "bmp"
                StreamT.Position = File.Position + 18
                File.Width = BinVal2(StreamT.Read(4))
                File.Height = BinVal2(StreamT.Read(4))
                StreamT.Position = File.Position + 2
                File.Size = BinVal2(StreamT.Read(4))
            Case "application/x-shockwave-flash"
                If LCase(File.Extend)<>"swf" Then File.Extend = "swf"
                StreamT.Position = File.Position
                If Ascb(StreamT.Read(1)) = &H46 Then
                    StreamT.Position = File.Position + 8
                    strTemp = Num2Str(Ascb(StreamT.Read(1)), 2 , 8)
                    intTemp = Str2Num(Left(strTemp, 5), 2)
                    strTemp = Mid(strTemp, 6)
                    While (Len(strTemp) < intTemp * 4)
                        strTemp = strTemp & Num2Str(Ascb(StreamT.Read(1)), 2 , 8)
                    Wend
                    File.Width = Int(Abs(Str2Num(Mid(strTemp, intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 1, intTemp), 2)) / 20)
                    File.Height = Int(Abs(Str2Num(Mid(strTemp, 3 * intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 2 * intTemp + 1, intTemp), 2)) / 20)
                End If
        End Select
        If File.Width>0 And File.Height>0 Then
            IsImage = True
        Else
            IsImage = False
            File.Size = 0
        End If
    End Function

    Public Function Save(Byref Name, byval tOption, byval OverWrite)
        Dim File
        If Not IsObject(Name) Then
            Set File = Files(Name)
            If Not File.IsFile Then
                File.Succeed = False
                File.Exception = "错误的文件没有找到"
                Set Save = File
                Exit Function
            End If
        Else
            Set File = Name
        End If
        If Not File.IsFile Then
            File.Succeed = False
            File.Exception = "错误的文件没有找到"
            Set Save = File
            Exit Function
        End If
        On Error Resume Next
        Err.Clear
        Dim IsP, Path
        Path = mvarSavePath
        IsP = (InStr(mvarSavePath, ":") = 2)
        If Not IsP Then Path = Server.MapPath(mvarSavePath)
        Path = Replace(Path, "/", "\")
        If Mid(Path, Len(Path) - 1) <> "\" Then Path = Path + "\"
        CreateFolder Path
        File.Path = Replace(Replace(Path, Server.MapPath("/"), ""), "\", "/")
        If tOption = 1 Then
            Path = Path & File.LocalName
            File.FileName = File.LocalName
        Else
            If tOption = -1 And File.UserSetName <> "" Then
                Path = Path & File.UserSetName & "." & File.Extend
                File.FileName = File.UserSetName & "." & File.Extend
            Else
                Path = Path & File.NewName
                File.FileName = File.NewName
            End If
        End If
        If Not OverWrite Then
            Path = GetFilePath(File)
        End If
        Dim tmpStrm
        Set tmpStrm = Server.CreateObject("ADODB.Stream")
        tmpStrm.Mode = 3
        tmpStrm.Type = 1
        tmpStrm.Open
        StreamT.Position = File.Position
        StreamT.copyto tmpStrm, File.Size
        tmpStrm.SaveToFile Path, 2
        tmpStrm.Close
        Set tmpStrm = Nothing
        If Not Err Then
            File.Succeed = True
        Else
            Err.Clear()
            File.Succeed = False
            File.Exception = Err.Description
        End If
        Set Save = File
    End Function

    Public Function GetBinary(byval Name)
        Dim File
        Set File = Files(Name)
        If Not File.IsFile Then
            GetBinary = chrb(0)
            Exit Function
        End If
        StreamT.Position = File.Position
        GetBinary = StreamT.Read(File.Size)
    End Function

    Private Function GetNextFormName(byval formname)
        Dim formStart, currentIndex
        formStart = Left(formname, InStr(formname, vMuti) + Len(vMuti) -1)
        currentIndex = Mid(formname, InStr(formname, vMuti) + Len(vMuti))
        currentIndex = CInt(currentIndex)
        Do While Fils.Exists(formname)
            currentIndex = currentIndex + 1
            formname = formStart & currentIndex
        Loop
        GetNextFormName = formname
    End Function


    Private Function ReplaceEx(sourcestr, regString, Str)
        If IsNull(sourcestr) Then sourcestr = ""
        Dim re
        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        re.Pattern = "" & regString & ""
        Str = re.Replace(sourcestr, Str)
        Set re = Nothing
        ReplaceEx = Str
    End Function


    Private Function CreateFolder(ByVal folderPath)
        Easp.Fso.CreateFolder folderPath
    End Function

    Private Function GetFilePath(Byref File)
        Dim oFSO, Fname , FNameL , i
        i = 0
        Set oFSO = Server.CreateObject(Easp.FsoName())
        Fname = Server.MapPath(File.Path & File.FileName)
        FNameL = Mid(File.FileName, 1, InStr(File.FileName, ".") - 1)
        Do While oFSO.FileExists(Fname)
            Fname = Server.MapPath(File.Path & FNameL & "(" & i & ")." & File.Extend)
            File.FileName = FNameL & "(" & i & ")." & File.Extend
            i = i + 1
        Loop
        Set oFSO = Nothing
        GetFilePath = Fname
    End Function

    Private Function NewFile()
        Execute "Set NewFile = new " & mvarClsName
        NewFile.Width = 0
        NewFile.Height = 0
    End Function

    Private Function BinVal2(bin)
        Dim lngValue, i
        lngValue = 0
        For i = lenb(bin) To 1 step -1
            lngValue = lngValue * 256 + Ascb(midb(bin, i, 1))
        Next
        BinVal2 = lngValue
    End Function

    Private Function Bin2Val(bin)
        Dim lngValue, i
        lngValue = 0
        For i = 1 To lenb(bin)
            lngValue = lngValue * 256 + Ascb(midb(bin, i, 1))
        Next
        Bin2Val = lngValue
    End Function

    Private Function Num2Str(num, Base, lens)
        Dim ret, i
        ret = ""
        While (num >= Base)
            i = num Mod Base
            ret = i & ret
            num = (num - i) / Base
        Wend
        Num2Str = Right(String(lens, "0") & num & ret, lens)
    End Function

    Private Function Str2Num(Str, Base)
        Dim ret, i
        ret = 0
        For i = 1 To Len(Str)
            ret = ret * Base + CInt(Mid(Str, i, 1))
        Next
        Str2Num = ret
    End Function

End Class
%>