asp无组件上传图片并生成缩略图

 

1. 先创建一文件夹，并创建虚拟目录或站长点。
2. 1.增加上传页xAdd.html
8. "POST" name="myform" action="xSave.asp" target="_self">
9. "PicPath" type="text" id="PicPath" readonly="true">
10. "sPicPath" type="hidden" id="sPicPath">
11. "Upload" src="upload.htm" frameborder=0 scrolling=no width="100%" height="20">
12. "" id="objimg" style="display:none;" />
16. 2.上传页upload.htm
19. "Content-Type" content="text/html; charset=gb2312">
21. function check_file() 
22. {
23.   var strFileName=form.FileName.value;
24.   if (strFileName=="")
25.   {
26.     alert("请选择要上传的文件");
27.     return false;
28.   }
29. }
32. "0" topmargin="0">
33. "upfile.asp" method="post" name="form1" enctype="multipart/form-data">
34.   "FileName" type="FILE" class="tx1" size="20" onChange="window.parent.document.getElementById('objimg').src=this.value;window.parent.document.getElementById('objimg').style.display='';">
35.   "submit" name="Submit" value="上传">
39. 3.上传保存代码页upfile.asp
41. <%
42. Const MaxFileSize=300        '上传文件大小限制单位k
43. Const UpFileType="gif|jpg|bmp|png"        '允许的上传文件类型
44. set fs=createobject("scripting.filesystemobject") 
45. %>
48. "Content-Type" content="text/html; charset=gb2312">
51. <%
52. call upload_0()  '使用化境无组件上传类
53. %>
56. <%
57. sub upload_0()    '使用化境无组件上传类
58.     set upload=new upload_file    '建立上传对象
59.     for each formName in upload.file '列出所有上传了的文件
60.         set file=upload.file(formName)  '生成一个文件对象
61.         if file.filesize<100 then
62.             msg="请先选择你要上传的文件！"
63.             founderr=true
64.         end if
65.         if file.filesize>(MaxFileSize*1024) then
66.             msg="文件大小超过了限制，最大只能上传" & CStr(MaxFileSize) & "K的文件！"
67.             founderr=true
68.         end if
70.         fileExt=lcase(file.FileExt)
71.         Forumupload=split(UpFileType,"|")
72.         for i=0 to ubound(Forumupload)
73.             if fileEXT=trim(Forumupload(i)) then
74.                 EnableUpload=true
75.                 exit for
76.             end if
77.         next
78.         if fileEXT="asp" or fileEXT="asa" or fileEXT="aspx" then
79.             EnableUpload=false
80.         end if
81.         if EnableUpload=false then
82.             msg="这种文件类型不允许上传！/n/n只允许上传这几种文件类型：" & UpFileType
83.                         response.write"alert('这种文件类型不允许上传！/n/n只允许上传这几种文件类型：" & UpFileType & "');"
84.                         response.write"javascript:history.go(-1)"
85.          founderr=true
86.         end if
87.         
88.         strJS="" & vbcrlf
89.         if founderr<>true then
90.             randomize
91.             ranNum=int(900*rnd)+100
92.             filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum"."
94.             file.SaveToFile Server.mappath(FileName)   '保存文件
95.             file_on=Server.mappath(FileName)
96.             if fs.FileExists(file_on) then
97.                 Set Jpeg = Server.CreateObject("Persits.Jpeg") 
98.                 Jpeg.Open file_on
99.                 IW=Jpeg.OriginalWidth
100.                 IH=Jpeg.OriginalHeight
101.                 XH=130
102.                 XW=130
103.                 If IH>IW Then
104.                     VW =cint( XH*IW/IH)
105.                     VH=XH
106.                 Else
107.                     if IH=IW THEN
108.                         VW=XW
109.                         VH=XH
110.                     ELSE
111.                         VW = XW
112.                         VH=cint(XW*IH/IW)
113.                     end if
114.                     
115.                 End If
116.                 Jpeg.Width = VW
117.                 Jpeg.Height = VH
118.                 fname1=split(Filename,"/")
119.                 chsave="s"&fname1(Ubound(fname1))
120.                 Jpeg.Save Server.MapPath(chsave)
121.                 Jpeg.close
122.                 Set Jpeg = nothing
123.                 msg="保存缩位图成功! --"
124.             else 
125.                 msg="保存缩位图不成功!--"
126.             end if
127.             msg=msg"上传文件成功！"
128.             FileType=right(fileExt,3)
129.             strJS=strJS & "window.parent.document.getElementById('PicPath').value='" & replace(filename,"../","") & "';" & vbcrlf
130.             strJS=strJS & "window.parent.document.getElementById('sPicPath').value='" & replace(chsave,"../","") & "';" & vbcrlf
131.         end if
132.         strJS=strJS & "alert('" & msg & "');" & vbcrlf
133.         strJS=strJS & "history.go(-1);" & vbcrlf
134.         strJS=strJS & ""
135.         response.write strJS
136.         set file=nothing
137.     next
138.     set upload=nothing
139. end sub
140. %>
141. 4.upload.asp页
142. <%
143. '----------------------------------------------------------------------
144. '转发时请保留此声明信息,这段声明不并会影响你的速度!
145. '*******************    无组件上传类   ********************************
146. '声明:此上传类是在化境编程界发布的无组件上传类的基础上修改的.
147. '在与化境编程界无组件上传类相比,速度快了将近50倍,当上传4M大小的文件时
148. '服务器只需要10秒就可以处理完,是目前最快的无组件上传程序,当前版本为0.96
149. '源代码公开,免费使用,对于商业用途,请与作者联系
150. '文件属性：例如上传文件为c:/myfile/doc.txt
151. 'FileName    文件名       字符串    "doc.txt"
152. 'FileSize    文件大小     数值       1210
153. 'FileType    文件类型     字符串    "text/plain"
154. 'FileExt     文件扩展名   字符串    "txt"
155. 'FilePath    文件原路径   字符串    "c:/myfile"
156. '使用时注意事项:
157. '由于Scripting.Dictionary区分大小写,所以在网页及ASP页的项目名都要相同的大小
158. '写,如果人习惯用大写或小写,为了防止出错的话,可以把
159. 'sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
160. '改为
161. '(小写者)sFormName = LCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
162. '(大写者)sFormName = UCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
163. '**********************************************************************
164. '----------------------------------------------------------------------
165. dim oUpFileStream
167. Class upload_file
168.   
169. dim Form,File,Version
170.   
171. Private Sub Class_Initialize 
172.    '定义变量
173.   dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
174.   dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
175.   dim iFindStart,iFindEnd
176.   dim iFormStart,iFormEnd,sFormName
177.    '代码开始
178.   Version="无组件上传类 Version 0.96"
179.   set Form = Server.CreateObject("Scripting.Dictionary")
180.   set File = Server.CreateObject("Scripting.Dictionary")
181.   if Request.TotalBytes < 1 then Exit Sub
182.   set tStream = Server.CreateObject("adodb.stream")
183.   set oUpFileStream = Server.CreateObject("adodb.stream")
184.   oUpFileStream.Type = 1
185.   oUpFileStream.Mode = 3
186.   oUpFileStream.Open 
187.   oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)
188.   oUpFileStream.Position=0
189.   RequestBinDate = oUpFileStream.Read 
190.   iFormEnd = oUpFileStream.Size
191.   bCrLf = chrB(13) & chrB(10)
192.   '取得每个项目之间的分隔符
193.   sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
194.   iStart = LenB (sStart)
195.   iFormStart = iStart+2
196.   '分解项目
197.   Do
198.     iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
199.     tStream.Type = 1
200.     tStream.Mode = 3
201.     tStream.Open
202.     oUpFileStream.Position = iFormStart
203.     oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
204.     tStream.Position = 0
205.     tStream.Type = 2
206.     tStream.Charset ="gb2312"
207.     sInfo = tStream.ReadText      
208.     '取得表单项目名称
209.     iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1
210.     iFindStart = InStr(22,sInfo,"name=""",1)+6
211.     iFindEnd = InStr(iFindStart,sInfo,"""",1)
212.     sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
213.     '如果是文件
214.     if InStr (45,sInfo,"filename=""",1) > 0 then
215.       set oFileInfo= new FileInfo
216.       '取得文件属性
217.       iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
218.       iFindEnd = InStr(iFindStart,sInfo,"""",1)
219.       sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
220.       oFileInfo.FileName = GetFileName(sFileName)
221.       oFileInfo.FilePath = GetFilePath(sFileName)
222.       oFileInfo.FileExt = GetFileExt(sFileName)
223.       iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
224.       iFindEnd = InStr(iFindStart,sInfo,vbCr)
225.       oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
226.       oFileInfo.FileStart = iInfoEnd
227.       oFileInfo.FileSize = iFormStart -iInfoEnd -2
228.       oFileInfo.FormName = sFormName
229.       file.add sFormName,oFileInfo
230.     else
231.     '如果是表单项目
232.       tStream.Close
233.       tStream.Type = 1
234.       tStream.Mode = 3
235.       tStream.Open
236.       oUpFileStream.Position = iInfoEnd 
237.       oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
238.       tStream.Position = 0
239.       tStream.Type = 2
240.       tStream.Charset = "gb2312"
241.       sFormvalue = tStream.ReadText 
242.       form.Add sFormName,sFormvalue
243.     end if
244.     tStream.Close
245.     iFormStart = iFormStart+iStart+2
246.     '如果到文件尾了就退出
247.     loop until (iFormStart+2) = iFormEnd 
248.   RequestBinDate=""
249.   set tStream = nothing
250. End Sub
252. Private Sub Class_Terminate  
253.   '清除变量及对像
254.   if not Request.TotalBytes<1 then
255.     oUpFileStream.Close
256.     set oUpFileStream =nothing
257.     end if
258.   Form.RemoveAll
259.   File.RemoveAll
260.   set Form=nothing
261.   set File=nothing
262. End Sub
263.    
264.  '取得文件路径
265. Private function GetFilePath(FullPath)
266.   If FullPath <> "" Then
267.     GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
268.     Else
269.     GetFilePath = ""
270.   End If
271. End function
273. '取得文件名
274. Private function GetFileName(FullPath)
275.   If FullPath <> "" Then
276.     GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
277.     Else
278.     GetFileName = ""
279.   End If
280. End function
282. '取得扩展名
283. Private function GetFileExt(FullPath)
284.   If FullPath <> "" Then
285.     GetFileExt = mid(FullPath,InStrRev(FullPath, ".")+1)
286.     Else
287.     GetFileExt = ""
288.   End If
289. End function
291. End Class
293. '文件属性类
294. Class FileInfo
295.   dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
296.   Private Sub Class_Initialize 
297.     FileName = ""
298.     FilePath = ""
299.     FileSize = 0
300.     FileStart= 0
301.     FormName = ""
302.     FileType = ""
303.     FileExt = ""
304.   End Sub
305.   
306. '保存文件方法
307.  Public function SaveToFile(FullPath)
308.     dim oFileStream,ErrorChar,i
309.     SaveToFile=1
310.     if trim(fullpath)="" or right(fullpath,1)="/" then exit function
311.     set oFileStream=CreateObject("Adodb.Stream")
312.     oFileStream.Type=1
313.     oFileStream.Mode=3
314.     oFileStream.Open
315.     oUpFileStream.position=FileStart
316.     oUpFileStream.copyto oFileStream,FileSize
317.     oFileStream.SaveToFile FullPath,2
318.     oFileStream.Close
319.     set oFileStream=nothing 
320.     SaveToFile=0
321.   end function
322. End Class
323. %>