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