<%
'----------------------------------------------------------------------
'                CHEditor ASP File Upload Class
'
' 1. attach 디렉토리는 웹에서 파일을 쓰고, 읽을 수 있도록 퍼미션을 조정하여 주십시오.
' 2. 이미지 업로드는 "\program Files\Common Files\System\ado\msado15.dll" 를 이용합니다.
'    만약 위 모듈이 레지스트리에 등록되어 있지 않을 경우, regsvr32 명령을 이용하여 등록하여 주십시오.
'
' 보기: regsvr32 "c:\program files\common files\system\ado\msado15.dll"

' ASP의 경우 기본 업로드 크기가 200K로 기본 설정이 되어있습니다.
' 아래 과정을 통해 원하는 파일 크기로 재설정할 수 있습니다.

' 1. IIS 서비스를 멈춤니다.
' 2. 'c:\windows\system32\inetsrv\Metabase.XML' 파일을 간단한 에디터(노트패드와 같은) 열어
'    AspMaxRequestEntityAllowed="204800"으로 설정되어 있는 값을 원하는는 크기로 수정합니다.
' 3. IIS를 시작합니다.
'----------------------------------------------------------------------

const DEFAULT_CHUNK_SIZE = 200000
const adModeReadWrite = 3
const adTypeBinary = 1
const adTypeText = 2
const adSaveCreateOverWrite = 2

Class fileUploadClass
    Public UploadedFiles
    Public FormElements

    Private VarArrayBinRequest
    Private StreamRequest
    Private uploadedYet
    Private internalChunkSize
    Private SaveDirectory

    Private Sub Class_Initialize()
        Set UploadedFiles   = Server.CreateObject("Scripting.Dictionary")
        Set FormElements    = Server.CreateObject("Scripting.Dictionary")
        Set StreamRequest   = Server.CreateObject("ADODB.Stream")
        With StreamRequest
            .Open
            .Type = adTypeText
        End With
        uploadedYet = false
        internalChunkSize = DEFAULT_CHUNK_SIZE
    End Sub

    Private Sub Class_Terminate()
        If IsObject(UploadedFiles) Then
            UploadedFiles.RemoveAll()
            Set UploadedFiles = Nothing
        End If
        If IsObject(FormElements) Then
            FormElements.RemoveAll()
            Set FormElements = Nothing
        End If
        StreamRequest.Close
        Set StreamRequest = Nothing
    End Sub

    Public Property Get Form(sIndex)
        Form = ""
        If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
    End Property

    Public Property Get Files()
        Files = UploadedFiles.Items
    End Property

    Public Property Get Exists(sIndex)
        Exists = false
        If FormElements.Exists(LCase(sIndex)) Then Exists = true
    End Property

    Public Property Get FileExists(sIndex)
        FileExists = false
        if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true
    End Property

    Public Property Get chunkSize()
        chunkSize = internalChunkSize
    End Property

    Public Property Let chunkSize(sz)
        internalChunkSize = sz
    End Property

    Public Sub Save(path)
        Dim streamFile, fileItem, filePath

        If Right(path, 1) <> "\" then path = path & "\"
		SaveDirectory = path

        If not uploadedYet then Upload

        For Each fileItem In UploadedFiles.Items
            filePath = path & fileItem.FileName
            Set streamFile = Server.CreateObject("ADODB.Stream")
            streamFile.Type = adTypeBinary
            streamFile.Open
            StreamRequest.Position=fileItem.Start
            StreamRequest.CopyTo streamFile, fileItem.Length
            streamFile.SaveToFile filePath, adSaveCreateOverWrite
            streamFile.close
            Set streamFile = Nothing
            fileItem.Path = filePath
        Next
    End Sub

    Public Function SaveBinRequest(path)
        StreamRequest.SaveToFile path & "\debugStream.bin", 2
    End Function

    Public Sub Upload()
        Dim nCurPos, nDataBoundPos, nLastSepPos
        Dim nPosFile, nPosBound
        Dim sFieldName, osPathSep, auxStr
        Dim readBytes, readLoop, tmpBinRequest

        'RFC1867 토큰
        Dim vDataSep
        Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
        tNewLine = String2Byte(Chr(13))
        tDoubleQuotes = String2Byte(Chr(34))
        tTerm = String2Byte("--")
        tFilename = String2Byte("filename=""")
        tName = String2Byte("name=""")
        tContentDisp = String2Byte("Content-Disposition")
        tContentType = String2Byte("Content-Type:")

        uploadedYet = true

        on error resume next
            readBytes = internalChunkSize
            VarArrayBinRequest = Request.BinaryRead(readBytes)
            VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest))
            Do Until readBytes < 1
                tmpBinRequest = Request.BinaryRead(readBytes)
                if readBytes > 0 then
                    VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest))
                end if
            Loop

            StreamRequest.WriteText(VarArrayBinRequest)
            StreamRequest.Flush()

            if Err.Number <> 0 then
                response.write "<br><br><B>시스템 오류 목록:</B><p>"
                response.write Err.Description & "<p>"
                response.write "IIS MetaBase의 AspMaxRequestEntityAllowed 값을 설정하여 주십시오.<p>"
                Exit Sub
            end if
        on error goto 0 '리셋 오류 핸들링

        nCurPos = FindToken(tNewLine,1)

        If nCurPos <= 1  Then Exit Sub

        vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)

        '시작
        nDataBoundPos = 1

        '끝 라인 시작
        nLastSepPos = FindToken(vDataSep & tTerm, 1)

        Do Until nDataBoundPos = nLastSepPos
            nCurPos = SkipToken(tContentDisp, nDataBoundPos)
            nCurPos = SkipToken(tName, nCurPos)
            sFieldName = ExtractField(tDoubleQuotes, nCurPos)

            nPosFile = FindToken(tFilename, nCurPos)
            nPosBound = FindToken(vDataSep, nCurPos)

            If nPosFile <> 0 And  nPosFile < nPosBound Then
                Dim oUploadFile
                Set oUploadFile = New UploadedFile

                nCurPos = SkipToken(tFilename, nCurPos)
                auxStr = ExtractField(tDoubleQuotes, nCurPos)
                osPathSep = "\"

                If InStr(auxStr, osPathSep) = 0 then osPathSep = "/"

                oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))

                If (Len(oUploadFile.FileName) > 0) then
                    nCurPos = SkipToken(tContentType, nCurPos)

                    auxStr = ExtractField(tNewLine, nCurPos)
                    oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
                    nCurPos = FindToken(tNewLine, nCurPos) + 4 '빈 라인 건너 뜀

                    oUploadFile.Start = nCurPos+1
                    oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

                    If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
                End If
            Else
                Dim nEndOfData, fieldValueUniStr
                nCurPos = FindToken(tNewLine, nCurPos) + 4 '빈 라인 건너 뜀
                nEndOfData = FindToken(vDataSep, nCurPos) - 2
                fieldValueuniStr = ConvertUtf8BytesToString(nCurPos, nEndOfData-nCurPos)

                If Not FormElements.Exists(LCase(sFieldName)) Then
                    FormElements.Add LCase(sFieldName), fieldValueuniStr
                else
                   FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & fieldValueuniStr
                end if
            End If

            nDataBoundPos = FindToken(vDataSep, nCurPos)
        Loop
        'StreamRequest.WriteText(VarArrayBinRequest)
    End Sub

    Private Function SkipToken(sToken, nStart)
        SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
        If SkipToken = 0 then
            Response.write "처리중 오류가 발생하였습니다. IIS MetaBase의 AspMaxRequestEntityAllowed 값을 설정하여 주십시오.<p>"
            Response.End
        end if
        SkipToken = SkipToken + LenB(sToken)
    End Function

    Private Function FindToken(sToken, nStart)
        FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
    End Function

    Private Function ExtractField(sToken, nStart)
        Dim nEnd
        nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
        If nEnd = 0 then
            Response.write "처리중 오류가 발생하였습니다."
            Response.End
        end if
        ExtractField = ConvertUtf8BytesToString(nStart, nEnd-nStart)
    End Function

    Private Function String2Byte(sString)
        Dim i
        For i = 1 to Len(sString)
           String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1)))
        Next
    End Function

    Private Function ConvertUtf8BytesToString(start, length)
        StreamRequest.Position = 0
        Dim objStream
        Dim strTmp
        Set objStream = Server.CreateObject("ADODB.Stream")
        objStream.Charset = "utf-8"
        objStream.Mode = adModeReadWrite
        objStream.Type = adTypeBinary
        objStream.Open
        StreamRequest.Position = start+1
        StreamRequest.CopyTo objStream, length
        objStream.Flush
        objStream.Position = 0
        objStream.Type = adTypeText
        strTmp = objStream.ReadText
        objStream.Close

        Set objStream = Nothing
        ConvertUtf8BytesToString = strTmp
    End Function
End Class

Class UploadedFile
    Public ContentType
    Public Start
    Public Length
    Public Path
    Public origName
    Private nameOfFile

    Public Property Let FileName(fN)
        nameOfFile = fN
        nameOfFile = SubstNoReg(nameOfFile, "\", "_")
        nameOfFile = SubstNoReg(nameOfFile, "/", "_")
        nameOfFile = SubstNoReg(nameOfFile, ":", "_")
        nameOfFile = SubstNoReg(nameOfFile, "*", "_")
        nameOfFile = SubstNoReg(nameOfFile, "?", "_")
        nameOfFile = SubstNoReg(nameOfFile, """", "_")
        nameOfFile = SubstNoReg(nameOfFile, "<", "_")
        nameOfFile = SubstNoReg(nameOfFile, ">", "_")
        nameOfFile = SubstNoReg(nameOfFile, "|", "_")
    End Property

    Public Property Get FileName()
        FileName = nameOfFile
    End Property
End Class

Function SubstNoReg(initialStr, oldStr, newStr)
    Dim currentPos, oldStrPos, skip
    If IsNull(initialStr) Or Len(initialStr) = 0 Then
        SubstNoReg = ""
    ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
        SubstNoReg = initialStr
    Else
        If IsNull(newStr) Then newStr = ""
        currentPos = 1
        oldStrPos = 0
        SubstNoReg = ""
        skip = Len(oldStr)
        Do While currentPos <= Len(initialStr)
            oldStrPos = InStr(currentPos, initialStr, oldStr)
            If oldStrPos = 0 Then
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
                currentPos = Len(initialStr) + 1
            Else
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
                currentPos = oldStrPos + skip
            End If
        Loop
    End If
End Function

Function GetFileName(strSaveToPath, FileName)
    Dim Counter
    Dim Flag
    Dim strTempFileName
    Dim FileExt
    Dim NewFullPath
    Dim objFSO, p

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Counter = 0
    p = InStrRev(FileName, ".")
    FileExt = Mid(FileName, p+1)
    strTempFileName = Left(FileName, p-1)
    NewFullPath = strSaveToPath & "\" & FileName
    Flag = False

    Do Until Flag = True
        If objFSO.FileExists(NewFullPath) = False Then
            Flag = True
            GetFileName = Mid(NewFullPath, InstrRev(NewFullPath, "\") + 1)
        Else
            Counter = Counter + 1
            NewFullPath = strSaveToPath & "\" & strTempFileName & "_" & Counter & "." & FileExt
        End If
    Loop
End Function
%>