source: sandbox/filemanager/tp/fckeditor/editor/filemanager/connectors/asp/class_upload.asp @ 1575

Revision 1575, 9.6 KB checked in by amuller, 14 years ago (diff)

Ticket #597 - Implentação, melhorias do modulo gerenciador de arquivos
  • Property svn:executable set to *
Line 
1<%
2 ' FCKeditor - The text editor for Internet - http://www.fckeditor.net
3 ' Copyright (C) 2003-2009 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%>
Note: See TracBrowser for help on using the repository browser.