123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346 |
- <%
- '----------------------------------------------------------------------
- ' 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
- %>
|