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