<% ' FCKeditor - The text editor for Internet - http://www.fckeditor.net ' Copyright (C) 2003-2010 Frederico Caldeira Knabben ' ' == BEGIN LICENSE == ' ' Licensed under the terms of any of the following licenses at your ' choice: ' ' - GNU General Public License Version 2 or later (the "GPL") ' http://www.gnu.org/licenses/gpl.html ' ' - GNU Lesser General Public License Version 2.1 or later (the "LGPL") ' http://www.gnu.org/licenses/lgpl.html ' ' - Mozilla Public License Version 1.1 or later (the "MPL") ' http://www.mozilla.org/MPL/MPL-1.1.html ' ' == END LICENSE == ' ' These are the classes used to handle ASP upload without using third ' part components (OCX/DLL). %> <% '********************************************** ' File: NetRube_Upload.asp ' Version: NetRube Upload Class Version 2.3 Build 20070528 ' Author: NetRube ' Email: NetRube@126.com ' Date: 05/28/2007 ' Comments: The code for the Upload. ' This can free usage, but please ' not to delete this copyright information. ' If you have a modification version, ' Please send out a duplicate to me. '********************************************** ' 文件名: NetRube_Upload.asp ' 版本: NetRube Upload Class Version 2.3 Build 20070528 ' 作者: NetRube(网络乡巴佬) ' 电子邮件: NetRube@126.com ' 日期: 2007年05月28日 ' 声明: 文件上传类 ' 本上传类可以自由使用,但请保留此版权声明信息 ' 如果您对本上传类进行修改增强, ' 请发送一份给俺。 '********************************************** Class NetRube_Upload Public File, Form Private oSourceData Private nMaxSize, nErr, sAllowed, sDenied, sHtmlExtensions Private Sub Class_Initialize nErr = 0 nMaxSize = 1048576 Set File = Server.CreateObject("Scripting.Dictionary") File.CompareMode = 1 Set Form = Server.CreateObject("Scripting.Dictionary") Form.CompareMode = 1 Set oSourceData = Server.CreateObject("ADODB.Stream") oSourceData.Type = 1 oSourceData.Mode = 3 oSourceData.Open End Sub Private Sub Class_Terminate Form.RemoveAll Set Form = Nothing File.RemoveAll Set File = Nothing oSourceData.Close Set oSourceData = Nothing End Sub Public Property Get Version Version = "NetRube Upload Class Version 2.3 Build 20070528" End Property Public Property Get ErrNum ErrNum = nErr End Property Public Property Let MaxSize(nSize) nMaxSize = nSize End Property Public Property Let Allowed(sExt) sAllowed = sExt End Property Public Property Let Denied(sExt) sDenied = sExt End Property Public Property Let HtmlExtensions(sExt) sHtmlExtensions = sExt End Property Public Sub GetData Dim aCType aCType = Split(Request.ServerVariables("HTTP_CONTENT_TYPE"), ";") if ( uBound(aCType) < 0 ) then nErr = 1 Exit Sub end if If aCType(0) <> "multipart/form-data" Then nErr = 1 Exit Sub End If Dim nTotalSize nTotalSize = Request.TotalBytes If nTotalSize < 1 Then nErr = 2 Exit Sub End If If nMaxSize > 0 And nTotalSize > nMaxSize Then nErr = 3 Exit Sub End If 'Thankful long(yrl031715@163.com) 'Fix upload large file. '********************************************** ' 修正作者:long ' 联系邮件: yrl031715@163.com ' 修正时间:2007年5月6日 ' 修正说明:由于iis6的Content-Length 头信息中包含的请求长度超过了 AspMaxRequestEntityAllowed 的值(默认200K), IIS 将返回一个 403 错误信息. ' 直接导致在iis6下调试FCKeditor上传功能时,一旦文件超过200K,上传文件时文件管理器失去响应,受此影响,文件的快速上传功能也存在在缺陷。 ' 在参考 宝玉 的 Asp无组件上传带进度条 演示程序后作出如下修改,以修正在iis6下的错误。 Dim nTotalBytes, nPartBytes, ReadBytes ReadBytes = 0 nTotalBytes = Request.TotalBytes '循环分块读取 Do While ReadBytes < nTotalBytes '分块读取 nPartBytes = 64 * 1024 '分成每块64k If nPartBytes + ReadBytes > nTotalBytes Then nPartBytes = nTotalBytes - ReadBytes End If oSourceData.Write Request.BinaryRead(nPartBytes) ReadBytes = ReadBytes + nPartBytes Loop '********************************************** oSourceData.Position = 0 Dim oTotalData, oFormStream, sFormHeader, sFormName, bCrLf, nBoundLen, nFormStart, nFormEnd, nPosStart, nPosEnd, sBoundary oTotalData = oSourceData.Read bCrLf = ChrB(13) & ChrB(10) sBoundary = MidB(oTotalData, 1, InStrB(1, oTotalData, bCrLf) - 1) nBoundLen = LenB(sBoundary) + 2 nFormStart = nBoundLen Set oFormStream = Server.CreateObject("ADODB.Stream") Do While (nFormStart + 2) < nTotalSize nFormEnd = InStrB(nFormStart, oTotalData, bCrLf & bCrLf) + 3 With oFormStream .Type = 1 .Mode = 3 .Open oSourceData.Position = nFormStart oSourceData.CopyTo oFormStream, nFormEnd - nFormStart .Position = 0 .Type = 2 .CharSet = "UTF-8" sFormHeader = .ReadText .Close End With nFormStart = InStrB(nFormEnd, oTotalData, sBoundary) - 1 nPosStart = InStr(22, sFormHeader, " name=", 1) + 7 nPosEnd = InStr(nPosStart, sFormHeader, """") sFormName = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) If InStr(45, sFormHeader, " filename=", 1) > 0 Then Set File(sFormName) = New NetRube_FileInfo File(sFormName).FormName = sFormName File(sFormName).Start = nFormEnd File(sFormName).Size = nFormStart - nFormEnd - 2 nPosStart = InStr(nPosEnd, sFormHeader, " filename=", 1) + 11 nPosEnd = InStr(nPosStart, sFormHeader, """") File(sFormName).ClientPath = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) File(sFormName).Name = Mid(File(sFormName).ClientPath, InStrRev(File(sFormName).ClientPath, "\") + 1) File(sFormName).Ext = LCase(Mid(File(sFormName).Name, InStrRev(File(sFormName).Name, ".") + 1)) nPosStart = InStr(nPosEnd, sFormHeader, "Content-Type: ", 1) + 14 nPosEnd = InStr(nPosStart, sFormHeader, vbCr) File(sFormName).MIME = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) Else With oFormStream .Type = 1 .Mode = 3 .Open oSourceData.Position = nFormEnd oSourceData.CopyTo oFormStream, nFormStart - nFormEnd - 2 .Position = 0 .Type = 2 .CharSet = "UTF-8" Form(sFormName) = .ReadText .Close End With End If nFormStart = nFormStart + nBoundLen Loop oTotalData = "" Set oFormStream = Nothing End Sub Public Sub SaveAs(sItem, sFileName) If File(sItem).Size < 1 Then nErr = 2 Exit Sub End If If Not IsAllowed(File(sItem).Ext) Then nErr = 4 Exit Sub End If If InStr( LCase( sFileName ), "::$data" ) > 0 Then nErr = 4 Exit Sub End If Dim sFileExt, iFileSize sFileExt = File(sItem).Ext iFileSize = File(sItem).Size ' Check XSS. If Not IsHtmlExtension( sFileExt ) Then ' Calculate the size of data to load (max 1Kb). Dim iXSSSize iXSSSize = iFileSize If iXSSSize > 1024 Then iXSSSize = 1024 End If ' Read the data. Dim sData oSourceData.Position = File(sItem).Start sData = oSourceData.Read( iXSSSize ) ' Byte Array sData = ByteArray2Text( sData ) ' String ' Sniff HTML data. If SniffHtml( sData ) Then nErr = 4 Exit Sub End If End If Dim oFileStream Set oFileStream = Server.CreateObject("ADODB.Stream") With oFileStream .Type = 1 .Mode = 3 .Open oSourceData.Position = File(sItem).Start oSourceData.CopyTo oFileStream, File(sItem).Size .Position = 0 .SaveToFile sFileName, 2 .Close End With Set oFileStream = Nothing End Sub Private Function IsAllowed(sExt) Dim oRE Set oRE = New RegExp oRE.IgnoreCase = True oRE.Global = True If sDenied = "" Then oRE.Pattern = "^(" & sAllowed & ")$" IsAllowed = (sAllowed = "") Or oRE.Test(sExt) Else oRE.Pattern = "^(" & sDenied & ")$" IsAllowed = Not oRE.Test(sExt) End If Set oRE = Nothing End Function Private Function IsHtmlExtension( sExt ) If sHtmlExtensions = "" Then Exit Function End If Dim oRE Set oRE = New RegExp oRE.IgnoreCase = True oRE.Global = True oRE.Pattern = "^(" & sHtmlExtensions & ")$" IsHtmlExtension = oRE.Test(sExt) Set oRE = Nothing End Function Private Function SniffHtml( sData ) Dim oRE Set oRE = New RegExp oRE.IgnoreCase = True oRE.Global = True Dim aPatterns aPatterns = Array( "