← Back to branch summary

~ubuntu-branches/ubuntu/precise/moin/precise-updates

« back to all changes in this revision

Viewing changes to wiki/htdocs/applets/FCKeditor/editor/filemanager/connectors/asp/class_upload.asp

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2008-11-13 16:45:52 UTC
  • mfrom: (0.1.5 sid)
  • Revision ID: james.westby@ubuntu.com-20081113164552-49t6zf2t2o5bqigh
Tags: 1.8.0-1ubuntu1
* Merge from debian unstable, remaining changes:
  - Drop recommendation of python-xml, the packages isn't anymore in
    sys.path.

Show diffs side-by-side

added added

removed removed

Lines of Context:
wiki/htdocs/applets/FCKeditor/editor/filemanager/connectors/asp/class_upload.asp
 
1
<%
 
2
 ' FCKeditor - The text editor for Internet - http://www.fckeditor.net
 
3
 ' Copyright (C) 2003-2008 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
 
 
48
Class 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
 
 
348
End Class
 
349
 
 
350
Class NetRube_FileInfo
 
351
        Dim FormName, ClientPath, Path, Name, Ext, Content, Size, MIME, Start
 
352
End Class
 
353
%>