- 先创建一文件夹,并创建虚拟目录或站长点。
- 1.增加上传页xAdd.html
- <html>
- <head>
- <title>无组件上传</title>
- </head>
- <body>
- <form method="POST" name="myform" action="xSave.asp" target="_self">
- <input name="PicPath" type="text" id="PicPath" readonly="true">
- <input name="sPicPath" type="hidden" id="sPicPath">
- <iframe id="Upload" src="upload.htm" frameborder=0 scrolling=no width="100%" height="20"></iframe>
- <img src="" id="objimg" style="display:none;" />
- </form>
- </body>
- </html>
- 2.上传页upload.htm
- <html>
- <head>
- <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
- <SCRIPT language=javascript>
- function check_file()
- {
- var strFileName=form.FileName.value;
- if (strFileName=="")
- {
- alert("请选择要上传的文件");
- return false;
- }
- }
- </SCRIPT>
- </head>
- <body leftmargin="0" topmargin="0">
- <form action="upfile.asp" method="post" name="form1" enctype="multipart/form-data">
- <input name="FileName" type="FILE" class="tx1" size="20" onChange="window.parent.document.getElementById('objimg').src=this.value;window.parent.document.getElementById('objimg').style.display='';">
- <input type="submit" name="Submit" value="上传">
- </form>
- </body>
- </html>
- 3.上传保存代码页upfile.asp
- <!--#include file="upload.asp"-->
- <%
- Const MaxFileSize=300 '上传文件大小限制单位k
- Const UpFileType="gif|jpg|bmp|png" '允许的上传文件类型
- set fs=createobject("scripting.filesystemobject")
- %>
- <html>
- <head>
- <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
- </head>
- <body>
- <%
- call upload_0() '使用化境无组件上传类
- %>
- </body>
- </html>
- <%
- sub upload_0() '使用化境无组件上传类
- set upload=new upload_file '建立上传对象
- for each formName in upload.file '列出所有上传了的文件
- set file=upload.file(formName) '生成一个文件对象
- if file.filesize<100 then
- msg="请先选择你要上传的文件!"
- founderr=true
- end if
- if file.filesize>(MaxFileSize*1024) then
- msg="文件大小超过了限制,最大只能上传" & CStr(MaxFileSize) & "K的文件!"
- founderr=true
- end if
- fileExt=lcase(file.FileExt)
- Forumupload=split(UpFileType,"|")
- for i=0 to ubound(Forumupload)
- if fileEXT=trim(Forumupload(i)) then
- EnableUpload=true
- exit for
- end if
- next
- if fileEXT="asp" or fileEXT="asa" or fileEXT="aspx" then
- EnableUpload=false
- end if
- if EnableUpload=false then
- msg="这种文件类型不允许上传!/n/n只允许上传这几种文件类型:" & UpFileType
- response.write"<SCRIPT language=JavaScript>alert('这种文件类型不允许上传!/n/n只允许上传这几种文件类型:" & UpFileType & "');"
- response.write"javascript:history.go(-1)</SCRIPT>"
- founderr=true
- end if
- strJS="<SCRIPT language=javascript>" & vbcrlf
- if founderr<>true then
- randomize
- ranNum=int(900*rnd)+100
- filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum"."
- file.SaveToFile Server.mappath(FileName) '保存文件
- file_on=Server.mappath(FileName)
- if fs.FileExists(file_on) then
- Set Jpeg = Server.CreateObject("Persits.Jpeg")
- Jpeg.Open file_on
- IW=Jpeg.OriginalWidth
- IH=Jpeg.OriginalHeight
- XH=130
- XW=130
- If IH>IW Then
- VW =cint( XH*IW/IH)
- VH=XH
- Else
- if IH=IW THEN
- VW=XW
- VH=XH
- ELSE
- VW = XW
- VH=cint(XW*IH/IW)
- end if
- End If
- Jpeg.Width = VW
- Jpeg.Height = VH
- fname1=split(Filename,"/")
- chsave="s"&fname1(Ubound(fname1))
- Jpeg.Save Server.MapPath(chsave)
- Jpeg.close
- Set Jpeg = nothing
- msg="保存缩位图成功! --"
- else
- msg="保存缩位图不成功!--"
- end if
- msg=msg"上传文件成功!"
- FileType=right(fileExt,3)
- strJS=strJS & "window.parent.document.getElementById('PicPath').value='" & replace(filename,"../","") & "';" & vbcrlf
- strJS=strJS & "window.parent.document.getElementById('sPicPath').value='" & replace(chsave,"../","") & "';" & vbcrlf
- end if
- strJS=strJS & "alert('" & msg & "');" & vbcrlf
- strJS=strJS & "history.go(-1);" & vbcrlf
- strJS=strJS & "</script>"
- response.write strJS
- set file=nothing
- next
- set upload=nothing
- end sub
- %>
- 4.upload.asp页
- <%
- '----------------------------------------------------------------------
- '转发时请保留此声明信息,这段声明不并会影响你的速度!
- '******************* 无组件上传类 ********************************
- '声明:此上传类是在化境编程界发布的无组件上传类的基础上修改的.
- '在与化境编程界无组件上传类相比,速度快了将近50倍,当上传4M大小的文件时
- '服务器只需要10秒就可以处理完,是目前最快的无组件上传程序,当前版本为0.96
- '源代码公开,免费使用,对于商业用途,请与作者联系
- '文件属性:例如上传文件为c:/myfile/doc.txt
- 'FileName 文件名 字符串 "doc.txt"
- 'FileSize 文件大小 数值 1210
- 'FileType 文件类型 字符串 "text/plain"
- 'FileExt 文件扩展名 字符串 "txt"
- 'FilePath 文件原路径 字符串 "c:/myfile"
- '使用时注意事项:
- '由于Scripting.Dictionary区分大小写,所以在网页及ASP页的项目名都要相同的大小
- '写,如果人习惯用大写或小写,为了防止出错的话,可以把
- 'sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
- '改为
- '(小写者)sFormName = LCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
- '(大写者)sFormName = UCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
- '**********************************************************************
- '----------------------------------------------------------------------
- dim oUpFileStream
- Class upload_file
- dim Form,File,Version
- Private Sub Class_Initialize
- '定义变量
- dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
- dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
- dim iFindStart,iFindEnd
- dim iFormStart,iFormEnd,sFormName
- '代码开始
- Version="无组件上传类 Version 0.96"
- set Form = Server.CreateObject("Scripting.Dictionary")
- set File = Server.CreateObject("Scripting.Dictionary")
- if Request.TotalBytes < 1 then Exit Sub
- set tStream = Server.CreateObject("adodb.stream")
- set oUpFileStream = Server.CreateObject("adodb.stream")
- oUpFileStream.Type = 1
- oUpFileStream.Mode = 3
- oUpFileStream.Open
- oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)
- oUpFileStream.Position=0
- RequestBinDate = oUpFileStream.Read
- iFormEnd = oUpFileStream.Size
- bCrLf = chrB(13) & chrB(10)
- '取得每个项目之间的分隔符
- sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
- iStart = LenB (sStart)
- iFormStart = iStart+2
- '分解项目
- Do
- iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
- tStream.Type = 1
- tStream.Mode = 3
- tStream.Open
- oUpFileStream.Position = iFormStart
- oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
- tStream.Position = 0
- tStream.Type = 2
- tStream.Charset ="gb2312"
- sInfo = tStream.ReadText
- '取得表单项目名称
- iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1
- iFindStart = InStr(22,sInfo,"name=""",1)+6
- iFindEnd = InStr(iFindStart,sInfo,"""",1)
- sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
- '如果是文件
- if InStr (45,sInfo,"filename=""",1) > 0 then
- set oFileInfo= new FileInfo
- '取得文件属性
- iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
- iFindEnd = InStr(iFindStart,sInfo,"""",1)
- sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
- oFileInfo.FileName = GetFileName(sFileName)
- oFileInfo.FilePath = GetFilePath(sFileName)
- oFileInfo.FileExt = GetFileExt(sFileName)
- iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
- iFindEnd = InStr(iFindStart,sInfo,vbCr)
- oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
- oFileInfo.FileStart = iInfoEnd
- oFileInfo.FileSize = iFormStart -iInfoEnd -2
- oFileInfo.FormName = sFormName
- file.add sFormName,oFileInfo
- else
- '如果是表单项目
- tStream.Close
- tStream.Type = 1
- tStream.Mode = 3
- tStream.Open
- oUpFileStream.Position = iInfoEnd
- oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
- tStream.Position = 0
- tStream.Type = 2
- tStream.Charset = "gb2312"
- sFormvalue = tStream.ReadText
- form.Add sFormName,sFormvalue
- end if
- tStream.Close
- iFormStart = iFormStart+iStart+2
- '如果到文件尾了就退出
- loop until (iFormStart+2) = iFormEnd
- RequestBinDate=""
- set tStream = nothing
- End Sub
- Private Sub Class_Terminate
- '清除变量及对像
- if not Request.TotalBytes<1 then
- oUpFileStream.Close
- set oUpFileStream =nothing
- end if
- Form.RemoveAll
- File.RemoveAll
- set Form=nothing
- set File=nothing
- End Sub
- '取得文件路径
- Private function GetFilePath(FullPath)
- If FullPath <> "" Then
- GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
- Else
- GetFilePath = ""
- End If
- End function
- '取得文件名
- Private function GetFileName(FullPath)
- If FullPath <> "" Then
- GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
- Else
- GetFileName = ""
- End If
- End function
- '取得扩展名
- Private function GetFileExt(FullPath)
- If FullPath <> "" Then
- GetFileExt = mid(FullPath,InStrRev(FullPath, ".")+1)
- Else
- GetFileExt = ""
- End If
- End function
- End Class
- '文件属性类
- Class FileInfo
- dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
- Private Sub Class_Initialize
- FileName = ""
- FilePath = ""
- FileSize = 0
- FileStart= 0
- FormName = ""
- FileType = ""
- FileExt = ""
- End Sub
- '保存文件方法
- Public function SaveToFile(FullPath)
- dim oFileStream,ErrorChar,i
- SaveToFile=1
- if trim(fullpath)="" or right(fullpath,1)="/" then exit function
- set oFileStream=CreateObject("Adodb.Stream")
- oFileStream.Type=1
- oFileStream.Mode=3
- oFileStream.Open
- oUpFileStream.position=FileStart
- oUpFileStream.copyto oFileStream,FileSize
- oFileStream.SaveToFile FullPath,2
- oFileStream.Close
- set oFileStream=nothing
- SaveToFile=0
- end function
- End Class
- %>
asp无组件上传图片并生成缩略图
最新推荐文章于 2025-05-30 12:27:19 发布