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.1 Build 20050228
28' Author:	NetRube
29' Email:	NetRube@126.com
30' Date:		02/28/2005
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.1 Build 20050228
39' 作者:		NetRube(网络乡巴佬)
40' 电子邮件:	NetRube@126.com
41' 日期:		2005年02月28日
42' 声明:		文件上传类
43'			本上传类可以自由使用，但请保留此版权声明信息
44'			如果您对本上传类进行修改增强，
45'			请发送一份给俺。
46'**********************************************
47
48Class NetRube_Upload
49
50	Public	File, Form
51	Private oSourceData
52	Private nMaxSize, nErr, sAllowed, sDenied
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 1.0 Build 20041218"
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 Sub GetData
100		Dim aCType
101		aCType = Split(Request.ServerVariables("HTTP_CONTENT_TYPE"), ";")
102		If aCType(0) <> "multipart/form-data" Then
103			nErr = 1
104			Exit Sub
105		End If
106
107		Dim nTotalSize
108		nTotalSize	= Request.TotalBytes
109		If nTotalSize < 1 Then
110			nErr = 2
111			Exit Sub
112		End If
113		If nMaxSize > 0 And nTotalSize > nMaxSize Then
114			nErr = 3
115			Exit Sub
116		End If
117
118		oSourceData.Write Request.BinaryRead(nTotalSize)
119		oSourceData.Position = 0
120
121		Dim oTotalData, oFormStream, sFormHeader, sFormName, bCrLf, nBoundLen, nFormStart, nFormEnd, nPosStart, nPosEnd, sBoundary
122
123		oTotalData	= oSourceData.Read
124		bCrLf		= ChrB(13) & ChrB(10)
125		sBoundary	= MidB(oTotalData, 1, InStrB(1, oTotalData, bCrLf) - 1)
126		nBoundLen	= LenB(sBoundary) + 2
127		nFormStart	= nBoundLen
128
129		Set oFormStream = Server.CreateObject("ADODB.Stream")
130
131		Do While (nFormStart + 2) < nTotalSize
132			nFormEnd	= InStrB(nFormStart, oTotalData, bCrLf & bCrLf) + 3
133
134			With oFormStream
135				.Type	= 1
136				.Mode	= 3
137				.Open
138				oSourceData.Position = nFormStart
139				oSourceData.CopyTo oFormStream, nFormEnd - nFormStart
140				.Position	= 0
141				.Type		= 2
142				.CharSet	= "UTF-8"
143				sFormHeader	= .ReadText
144				.Close
145			End With
146
147			nFormStart	= InStrB(nFormEnd, oTotalData, sBoundary) - 1
148			nPosStart	= InStr(22, sFormHeader, " name=", 1) + 7
149			nPosEnd		= InStr(nPosStart, sFormHeader, """")
150			sFormName	= Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
151
152			If InStr(45, sFormHeader, " filename=", 1) > 0 Then
153				Set File(sFormName)			= New NetRube_FileInfo
154				File(sFormName).FormName	= sFormName
155				File(sFormName).Start		= nFormEnd
156				File(sFormName).Size		= nFormStart - nFormEnd - 2
157				nPosStart					= InStr(nPosEnd, sFormHeader, " filename=", 1) + 11
158				nPosEnd						= InStr(nPosStart, sFormHeader, """")
159				File(sFormName).ClientPath	= Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
160				File(sFormName).Name		= Mid(File(sFormName).ClientPath, InStrRev(File(sFormName).ClientPath, "\") + 1)
161				File(sFormName).Ext			= LCase(Mid(File(sFormName).Name, InStrRev(File(sFormName).Name, ".") + 1))
162				nPosStart					= InStr(nPosEnd, sFormHeader, "Content-Type: ", 1) + 14
163				nPosEnd						= InStr(nPosStart, sFormHeader, vbCr)
164				File(sFormName).MIME		= Mid(sFormHeader, nPosStart, nPosEnd - nPosStart)
165			Else
166				With oFormStream
167					.Type	= 1
168					.Mode	= 3
169					.Open
170					oSourceData.Position = nPosEnd
171					oSourceData.CopyTo oFormStream, nFormStart - nFormEnd - 2
172					.Position	= 0
173					.Type		= 2
174					.CharSet	= "UTF-8"
175					Form(sFormName)	= .ReadText
176					.Close
177				End With
178			End If
179
180			nFormStart	= nFormStart + nBoundLen
181		Loop
182
183		oTotalData = ""
184		Set oFormStream = Nothing
185	End Sub
186
187	Public Sub SaveAs(sItem, sFileName)
188		If File(sItem).Size < 1 Then
189			nErr = 2
190			Exit Sub
191		End If
192
193		If Not IsAllowed(File(sItem).Ext) Then
194			nErr = 4
195			Exit Sub
196		End If
197
198		Dim oFileStream
199		Set oFileStream = Server.CreateObject("ADODB.Stream")
200		With oFileStream
201			.Type		= 1
202			.Mode		= 3
203			.Open
204			oSourceData.Position = File(sItem).Start
205			oSourceData.CopyTo oFileStream, File(sItem).Size
206			.Position	= 0
207			.SaveToFile sFileName, 2
208			.Close
209		End With
210		Set oFileStream = Nothing
211	End Sub
212
213	Private Function IsAllowed(sExt)
214		Dim oRE
215		Set oRE	= New RegExp
216		oRE.IgnoreCase	= True
217		oRE.Global		= True
218
219		If sDenied = "" Then
220			oRE.Pattern	= sAllowed
221			IsAllowed	= (sAllowed = "") Or oRE.Test(sExt)
222		Else
223			oRE.Pattern	= sDenied
224			IsAllowed	= Not oRE.Test(sExt)
225		End If
226
227		Set oRE	= Nothing
228	End Function
229End Class
230
231Class NetRube_FileInfo
232	Dim FormName, ClientPath, Path, Name, Ext, Content, Size, MIME, Start
233End Class
234%>