source: companies/serpro/news_admin/templates/celepar/fckeditor/editor/filemanager/browser/default/connectors/asp/class_upload.asp @ 903

Revision 903, 6.2 KB checked in by niltonneto, 15 years ago (diff)

Importacao inicial do Expresso do Serpro

Line 
1<!--
2 * FCKeditor - The text editor for internet
3 * Copyright (C) 2003-2006 Frederico Caldeira Knabben
4 *
5 * Licensed under the terms of the GNU Lesser General Public License:
6 *              http://www.opensource.org/licenses/lgpl-license.php
7 *
8 * For further information visit:
9 *              http://www.fckeditor.net/
10 *
11 * "Support Open Source software. What about a donation today?"
12 *
13 * File Name: class_upload.asp
14 *      These are the classes used to handle ASP upload without using third
15 *      part components (OCX/DLL).
16 *
17 * File Authors:
18 *              NetRube (netrube@126.com)
19-->
20<%
21'**********************************************
22' File:         NetRube_Upload.asp
23' Version:      NetRube Upload Class Version 2.1 Build 20050228
24' Author:       NetRube
25' Email:        NetRube@126.com
26' Date:         02/28/2005
27' Comments:     The code for the Upload.
28'                       This can free usage, but please
29'                       not to delete this copyright information.
30'                       If you have a modification version,
31'                       Please send out a duplicate to me.
32'**********************************************
33' 文件名:  NetRube_Upload.asp
34' 版本:           NetRube Upload Class Version 2.1 Build 20050228
35' 作者:           NetRube(网络乡巴佬)
36' 电子邮件: NetRube@126.com
37' 日期:           2005年02月28日
38' 声明:           文件上传类
39'                       本上传类可以自由使用,但请保留此版权声明信息
40'                       如果您对本上传类进行修改增强,
41'                       请发送一份给俺。
42'**********************************************
43
44Class NetRube_Upload
45
46        Public  File, Form
47        Private oSourceData
48        Private nMaxSize, nErr, sAllowed, sDenied
49       
50        Private Sub Class_Initialize
51                nErr            = 0
52                nMaxSize        = 1048576
53               
54                Set File                        = Server.CreateObject("Scripting.Dictionary")
55                File.CompareMode        = 1
56                Set Form                        = Server.CreateObject("Scripting.Dictionary")
57                Form.CompareMode        = 1
58               
59                Set oSourceData         = Server.CreateObject("ADODB.Stream")
60                oSourceData.Type        = 1
61                oSourceData.Mode        = 3
62                oSourceData.Open
63        End Sub
64       
65        Private Sub Class_Terminate
66                Form.RemoveAll
67                Set Form = Nothing
68                File.RemoveAll
69                Set File = Nothing
70               
71                oSourceData.Close
72                Set oSourceData = Nothing
73        End Sub
74       
75        Public Property Get Version
76                Version = "NetRube Upload Class Version 1.0 Build 20041218"
77        End Property
78
79        Public Property Get ErrNum
80                ErrNum  = nErr
81        End Property
82       
83        Public Property Let MaxSize(nSize)
84                nMaxSize        = nSize
85        End Property
86       
87        Public Property Let Allowed(sExt)
88                sAllowed        = sExt
89        End Property
90       
91        Public Property Let Denied(sExt)
92                sDenied = sExt
93        End Property
94
95        Public Sub GetData
96                Dim aCType
97                aCType = Split(Request.ServerVariables("HTTP_CONTENT_TYPE"), ";")
98                If aCType(0) <> "multipart/form-data" Then
99                        nErr = 1
100                        Exit Sub
101                End If
102               
103                Dim nTotalSize
104                nTotalSize      = Request.TotalBytes
105                If nTotalSize < 1 Then
106                        nErr = 2
107                        Exit Sub
108                End If
109                If nMaxSize > 0 And nTotalSize > nMaxSize Then
110                        nErr = 3
111                        Exit Sub
112                End If
113               
114                oSourceData.Write Request.BinaryRead(nTotalSize)
115                oSourceData.Position = 0
116               
117                Dim oTotalData, oFormStream, sFormHeader, sFormName, bCrLf, nBoundLen, nFormStart, nFormEnd, nPosStart, nPosEnd, sBoundary
118               
119                oTotalData      = oSourceData.Read
120                bCrLf           = ChrB(13) & ChrB(10)
121                sBoundary       = MidB(oTotalData, 1, InStrB(1, oTotalData, bCrLf) - 1)
122                nBoundLen       = LenB(sBoundary) + 2
123                nFormStart      = nBoundLen
124               
125                Set oFormStream = Server.CreateObject("ADODB.Stream")
126               
127                Do While (nFormStart + 2) < nTotalSize
128                        nFormEnd        = InStrB(nFormStart, oTotalData, bCrLf & bCrLf) + 3
129                       
130                        With oFormStream
131                                .Type   = 1
132                                .Mode   = 3
133                                .Open
134                                oSourceData.Position = nFormStart
135                                oSourceData.CopyTo oFormStream, nFormEnd - nFormStart
136                                .Position       = 0
137                                .Type           = 2
138                                .CharSet        = "UTF-8"
139                                sFormHeader     = .ReadText
140                                .Close
141                        End With
142                       
143                        nFormStart      = InStrB(nFormEnd, oTotalData, sBoundary) - 1
144                        nPosStart       = InStr(22, sFormHeader, " name=", 1) + 7
145                        nPosEnd         = InStr(nPosStart, sFormHeader, """")
146                        sFormName       = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
147                       
148                        If InStr(45, sFormHeader, " filename=", 1) > 0 Then
149                                Set File(sFormName)                     = New NetRube_FileInfo
150                                File(sFormName).FormName        = sFormName
151                                File(sFormName).Start           = nFormEnd
152                                File(sFormName).Size            = nFormStart - nFormEnd - 2
153                                nPosStart                                       = InStr(nPosEnd, sFormHeader, " filename=", 1) + 11
154                                nPosEnd                                         = InStr(nPosStart, sFormHeader, """")
155                                File(sFormName).ClientPath      = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
156                                File(sFormName).Name            = Mid(File(sFormName).ClientPath, InStrRev(File(sFormName).ClientPath, "\") + 1)
157                                File(sFormName).Ext                     = LCase(Mid(File(sFormName).Name, InStrRev(File(sFormName).Name, ".") + 1))
158                                nPosStart                                       = InStr(nPosEnd, sFormHeader, "Content-Type: ", 1) + 14
159                                nPosEnd                                         = InStr(nPosStart, sFormHeader, vbCr)
160                                File(sFormName).MIME            = Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
161                        Else
162                                With oFormStream
163                                        .Type   = 1
164                                        .Mode   = 3
165                                        .Open
166                                        oSourceData.Position = nPosEnd
167                                        oSourceData.CopyTo oFormStream, nFormStart - nFormEnd - 2
168                                        .Position       = 0
169                                        .Type           = 2
170                                        .CharSet        = "UTF-8"
171                                        Form(sFormName) = .ReadText
172                                        .Close
173                                End With
174                        End If
175                       
176                        nFormStart      = nFormStart + nBoundLen
177                Loop
178               
179                oTotalData = ""
180                Set oFormStream = Nothing
181        End Sub
182
183        Public Sub SaveAs(sItem, sFileName)
184                If File(sItem).Size < 1 Then
185                        nErr = 2
186                        Exit Sub
187                End If
188               
189                If Not IsAllowed(File(sItem).Ext) Then
190                        nErr = 4
191                        Exit Sub
192                End If
193               
194                Dim oFileStream
195                Set oFileStream = Server.CreateObject("ADODB.Stream")
196                With oFileStream
197                        .Type           = 1
198                        .Mode           = 3
199                        .Open
200                        oSourceData.Position = File(sItem).Start
201                        oSourceData.CopyTo oFileStream, File(sItem).Size
202                        .Position       = 0
203                        .SaveToFile sFileName, 2
204                        .Close
205                End With
206                Set oFileStream = Nothing
207        End Sub
208       
209        Private Function IsAllowed(sExt)
210                Dim oRE
211                Set oRE = New RegExp
212                oRE.IgnoreCase  = True
213                oRE.Global              = True
214               
215                If sDenied = "" Then
216                        oRE.Pattern     = sAllowed
217                        IsAllowed       = (sAllowed = "") Or oRE.Test(sExt)
218                Else
219                        oRE.Pattern     = sDenied
220                        IsAllowed       = Not oRE.Test(sExt)
221                End If
222               
223                Set oRE = Nothing
224        End Function
225End Class
226
227Class NetRube_FileInfo
228        Dim FormName, ClientPath, Path, Name, Ext, Content, Size, MIME, Start
229End Class
230%>
Note: See TracBrowser for help on using the repository browser.