1<% 2 ' FCKeditor - The text editor for Internet - http://www.fckeditor.net 3 ' Copyright (C) 2003-2007 Frederico Caldeira Knabben 4 ' 5 ' == BEGIN LICENSE == 6 ' 7 ' Licensed under the terms of any of the following licenses at your 8 ' choice: 9 ' 10 ' - GNU General Public License Version 2 or later (the "GPL") 11 ' http://www.gnu.org/licenses/gpl.html 12 ' 13 ' - GNU Lesser General Public License Version 2.1 or later (the "LGPL") 14 ' http://www.gnu.org/licenses/lgpl.html 15 ' 16 ' - Mozilla Public License Version 1.1 or later (the "MPL") 17 ' http://www.mozilla.org/MPL/MPL-1.1.html 18 ' 19 ' == END LICENSE == 20 ' 21 ' These are the classes used to handle ASP upload without using third 22 ' part components (OCX/DLL). 23%> 24<% 25'********************************************** 26' File: NetRube_Upload.asp 27' Version: NetRube Upload Class Version 2.3 Build 20070528 28' Author: NetRube 29' Email: NetRube@126.com 30' Date: 05/28/2007 31' Comments: The code for the Upload. 32' This can free usage, but please 33' not to delete this copyright information. 34' If you have a modification version, 35' Please send out a duplicate to me. 36'********************************************** 37' 文件名: NetRube_Upload.asp 38' 版本: NetRube Upload Class Version 2.3 Build 20070528 39' 作者: NetRube(网络乡巴佬) 40' 电子邮件: NetRube@126.com 41' 日期: 2007年05月28日 42' 声明: 文件上传类 43' 本上传类可以自由使用，但请保留此版权声明信息 44' 如果您对本上传类进行修改增强， 45' 请发送一份给俺。 46'********************************************** 47 48Class NetRube_Upload 49 50 Public File, Form 51 Private oSourceData 52 Private nMaxSize, nErr, sAllowed, sDenied, sHtmlExtensions 53 54 Private Sub Class_Initialize 55 nErr = 0 56 nMaxSize = 1048576 57 58 Set File = Server.CreateObject("Scripting.Dictionary") 59 File.CompareMode = 1 60 Set Form = Server.CreateObject("Scripting.Dictionary") 61 Form.CompareMode = 1 62 63 Set oSourceData = Server.CreateObject("ADODB.Stream") 64 oSourceData.Type = 1 65 oSourceData.Mode = 3 66 oSourceData.Open 67 End Sub 68 69 Private Sub Class_Terminate 70 Form.RemoveAll 71 Set Form = Nothing 72 File.RemoveAll 73 Set File = Nothing 74 75 oSourceData.Close 76 Set oSourceData = Nothing 77 End Sub 78 79 Public Property Get Version 80 Version = "NetRube Upload Class Version 2.3 Build 20070528" 81 End Property 82 83 Public Property Get ErrNum 84 ErrNum = nErr 85 End Property 86 87 Public Property Let MaxSize(nSize) 88 nMaxSize = nSize 89 End Property 90 91 Public Property Let Allowed(sExt) 92 sAllowed = sExt 93 End Property 94 95 Public Property Let Denied(sExt) 96 sDenied = sExt 97 End Property 98 99 Public Property Let HtmlExtensions(sExt) 100 sHtmlExtensions = sExt 101 End Property 102 103 Public Sub GetData 104 Dim aCType 105 aCType = Split(Request.ServerVariables("HTTP_CONTENT_TYPE"), ";") 106 if ( uBound(aCType) < 0 ) then 107 nErr = 1 108 Exit Sub 109 end if 110 If aCType(0) <> "multipart/form-data" Then 111 nErr = 1 112 Exit Sub 113 End If 114 115 Dim nTotalSize 116 nTotalSize = Request.TotalBytes 117 If nTotalSize < 1 Then 118 nErr = 2 119 Exit Sub 120 End If 121 If nMaxSize > 0 And nTotalSize > nMaxSize Then 122 nErr = 3 123 Exit Sub 124 End If 125 126 'Thankful long(yrl031715@163.com) 127 'Fix upload large file. 128 '********************************************** 129 ' 修正作者：long 130 ' 联系邮件: yrl031715@163.com 131 ' 修正时间：2007年5月6日 132 ' 修正说明：由于iis6的Content-Length 头信息中包含的请求长度超过了 AspMaxRequestEntityAllowed 的值（默认200K）, IIS 将返回一个 403 错误信息. 133 ' 直接导致在iis6下调试FCKeditor上传功能时，一旦文件超过200K,上传文件时文件管理器失去响应，受此影响，文件的快速上传功能也存在在缺陷。 134 ' 在参考 宝玉 的 Asp无组件上传带进度条 演示程序后作出如下修改，以修正在iis6下的错误。 135 136 Dim nTotalBytes, nPartBytes, ReadBytes 137 ReadBytes = 0 138 nTotalBytes = Request.TotalBytes 139 '循环分块读取 140 Do While ReadBytes < nTotalBytes 141 '分块读取 142 nPartBytes = 64 * 1024 '分成每块64k 143 If nPartBytes + ReadBytes > nTotalBytes Then 144 nPartBytes = nTotalBytes - ReadBytes 145 End If 146 oSourceData.Write Request.BinaryRead(nPartBytes) 147 ReadBytes = ReadBytes + nPartBytes 148 Loop 149 '********************************************** 150 oSourceData.Position = 0 151 152 Dim oTotalData, oFormStream, sFormHeader, sFormName, bCrLf, nBoundLen, nFormStart, nFormEnd, nPosStart, nPosEnd, sBoundary 153 154 oTotalData = oSourceData.Read 155 bCrLf = ChrB(13) & ChrB(10) 156 sBoundary = MidB(oTotalData, 1, InStrB(1, oTotalData, bCrLf) - 1) 157 nBoundLen = LenB(sBoundary) + 2 158 nFormStart = nBoundLen 159 160 Set oFormStream = Server.CreateObject("ADODB.Stream") 161 162 Do While (nFormStart + 2) < nTotalSize 163 nFormEnd = InStrB(nFormStart, oTotalData, bCrLf & bCrLf) + 3 164 165 With oFormStream 166 .Type = 1 167 .Mode = 3 168 .Open 169 oSourceData.Position = nFormStart 170 oSourceData.CopyTo oFormStream, nFormEnd - nFormStart 171 .Position = 0 172 .Type = 2 173 .CharSet = "UTF-8" 174 sFormHeader = .ReadText 175 .Close 176 End With 177 178 nFormStart = InStrB(nFormEnd, oTotalData, sBoundary) - 1 179 nPosStart = InStr(22, sFormHeader, " name=", 1) + 7 180 nPosEnd = InStr(nPosStart, sFormHeader, """") 181 sFormName = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) 182 183 If InStr(45, sFormHeader, " filename=", 1) > 0 Then 184 Set File(sFormName) = New NetRube_FileInfo 185 File(sFormName).FormName = sFormName 186 File(sFormName).Start = nFormEnd 187 File(sFormName).Size = nFormStart - nFormEnd - 2 188 nPosStart = InStr(nPosEnd, sFormHeader, " filename=", 1) + 11 189 nPosEnd = InStr(nPosStart, sFormHeader, """") 190 File(sFormName).ClientPath = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) 191 File(sFormName).Name = Mid(File(sFormName).ClientPath, InStrRev(File(sFormName).ClientPath, "\") + 1) 192 File(sFormName).Ext = LCase(Mid(File(sFormName).Name, InStrRev(File(sFormName).Name, ".") + 1)) 193 nPosStart = InStr(nPosEnd, sFormHeader, "Content-Type: ", 1) + 14 194 nPosEnd = InStr(nPosStart, sFormHeader, vbCr) 195 File(sFormName).MIME = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart) 196 Else 197 With oFormStream 198 .Type = 1 199 .Mode = 3 200 .Open 201 oSourceData.Position = nFormEnd 202 oSourceData.CopyTo oFormStream, nFormStart - nFormEnd - 2 203 .Position = 0 204 .Type = 2 205 .CharSet = "UTF-8" 206 Form(sFormName) = .ReadText 207 .Close 208 End With 209 End If 210 211 nFormStart = nFormStart + nBoundLen 212 Loop 213 214 oTotalData = "" 215 Set oFormStream = Nothing 216 End Sub 217 218 Public Sub SaveAs(sItem, sFileName) 219 If File(sItem).Size < 1 Then 220 nErr = 2 221 Exit Sub 222 End If 223 224 If Not IsAllowed(File(sItem).Ext) Then 225 nErr = 4 226 Exit Sub 227 End If 228 229 If InStr( LCase( sFileName ), "::$data" ) > 0 Then 230 nErr = 4 231 Exit Sub 232 End If 233 234 Dim sFileExt, iFileSize 235 sFileExt = File(sItem).Ext 236 iFileSize = File(sItem).Size 237 238 ' Check XSS. 239 If Not IsHtmlExtension( sFileExt ) Then 240 ' Calculate the size of data to load (max 1Kb). 241 Dim iXSSSize 242 iXSSSize = iFileSize 243 244 If iXSSSize > 1024 Then 245 iXSSSize = 1024 246 End If 247 248 ' Read the data. 249 Dim sData 250 oSourceData.Position = File(sItem).Start 251 sData = oSourceData.Read( iXSSSize ) ' Byte Array 252 sData = ByteArray2Text( sData ) ' String 253 254 ' Sniff HTML data. 255 If SniffHtml( sData ) Then 256 nErr = 4 257 Exit Sub 258 End If 259 End If 260 261 Dim oFileStream 262 Set oFileStream = Server.CreateObject("ADODB.Stream") 263 With oFileStream 264 .Type = 1 265 .Mode = 3 266 .Open 267 oSourceData.Position = File(sItem).Start 268 oSourceData.CopyTo oFileStream, File(sItem).Size 269 .Position = 0 270 .SaveToFile sFileName, 2 271 .Close 272 End With 273 Set oFileStream = Nothing 274 End Sub 275 276 Private Function IsAllowed(sExt) 277 Dim oRE 278 Set oRE = New RegExp 279 oRE.IgnoreCase = True 280 oRE.Global = True 281 282 If sDenied = "" Then 283 oRE.Pattern = sAllowed 284 IsAllowed = (sAllowed = "") Or oRE.Test(sExt) 285 Else 286 oRE.Pattern = sDenied 287 IsAllowed = Not oRE.Test(sExt) 288 End If 289 290 Set oRE = Nothing 291 End Function 292 293 Private Function IsHtmlExtension( sExt ) 294 If sHtmlExtensions = "" Then 295 Exit Function 296 End If 297 298 Dim oRE 299 Set oRE = New RegExp 300 oRE.IgnoreCase = True 301 oRE.Global = True 302 oRE.Pattern = sHtmlExtensions 303 304 IsHtmlExtension = oRE.Test(sExt) 305 306 Set oRE = Nothing 307 End Function 308 309 Private Function SniffHtml( sData ) 310 311 Dim oRE 312 Set oRE = New RegExp 313 oRE.IgnoreCase = True 314 oRE.Global = True 315 316 Dim aPatterns 317 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:" ) 318 319 Dim i 320 For i = 0 to UBound( aPatterns ) 321 oRE.Pattern = aPatterns( i ) 322 If oRE.Test( sData ) Then 323 SniffHtml = True 324 Exit Function 325 End If 326 Next 327 328 SniffHtml = False 329 330 End Function 331 332 ' Thanks to http://www.ericphelps.com/q193998/index.htm 333 Private Function ByteArray2Text(varByteArray) 334 Dim strData, strBuffer, lngCounter 335 strData = "" 336 strBuffer = "" 337 For lngCounter = 0 to UBound(varByteArray) 338 strBuffer = strBuffer & Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1))) 339 'Keep strBuffer at 1k bytes maximum 340 If lngCounter Mod 1024 = 0 Then 341 strData = strData & strBuffer 342 strBuffer = "" 343 End If 344 Next 345 ByteArray2Text = strData & strBuffer 346 End Function 347 348End Class 349 350Class NetRube_FileInfo 351 Dim FormName, ClientPath, Path, Name, Ext, Content, Size, MIME, Start 352End Class 353%>