%
'----------------------------------------------------------------------
'                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 "
시스템 오류 목록:
" response.write Err.Description & "
" response.write "IIS MetaBase의 AspMaxRequestEntityAllowed 값을 설정하여 주십시오.
" 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 값을 설정하여 주십시오.
" 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 %>