+++ /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