[asp常用代码]文件上传代码

调用实例:
ContractedBlock.gif ExpandedBlockStart.gif UploadDemo.html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Upload Demo</title>
<meta name="keywords" content="淄博本地信息网">
<meta name="author" content="淄博本地信息网">
</head>

<body>
<table width="100%" cellpadding="0" cellspacing="0" border="0">
 
<tr>
  
<td class=tdTitle>类别图片:</td>
  
<td>
   
<table width="100%" cellpadding="0" cellspacing="0" border="0">
    
<tr>
     
<td width="210"><input name="image" type="text" id="image" value="<%=image %>" style="width:200px"></td>
     
<td><iframe src="upload.asp?editname=image&uppath=catImg&filelx=jpg" frameborder=0 scrolling=no width="400" height="25"></iframe></td>
    
</tr>
   
</table>
  
</td>
 
</tr>
</table>
</body>
</html>

 

调用Upload.asp为显示浏览上传表单页面,代码如下:

 

ContractedBlock.gif ExpandedBlockStart.gif Upload.asp
ExpandedBlockStart.gifContractedBlock.gif<%
Dim uppath,filelx,formName,EditName
uppath  
="../"&request("uppath")&"/"        '文件上传路径
filelx  =request("filelx")                '文件上传类型
formName=request("formName")            '回传到上页面编辑框所在Form的Name
EditName=request("EditName")            '回传到上页面编辑框的Name
sizeName=request("sizename")            '回传到上页面编辑框的Name
%>
<html>
<head>
<title>图片上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
ExpandedBlockStart.gifContractedBlock.gif
<style type="text/css">
<!--
ExpandedSubBlockStart.gifContractedSubBlock.gifbody,form,td 
{}{margin:1px 0;padding:0;}
ExpandedSubBlockStart.gifContractedSubBlock.gifinput 
{}{height:21px;}
-->
</style>
</head>
<body bgcolor="#FFFFFF" text="#000000">
<form name="form1" method="post" action="uploadSave.asp" enctype="multipart/form-data" >
 
<input type="hidden" name="filepath" value="<%=uppath%>">
 
<input type="hidden" name="filelx" value="<%=filelx%>">
 
<input type="hidden" name="EditName" value="<%=EditName%>">
 
<input type="hidden" name="sizeName" value="<%=sizeName%>">
 
<input type="hidden" name="FormName" value="<%=formName%>">
 
<input type="hidden" name="act" value="uploadfile">
 
<table width="100%" cellspacing="0" cellpadding="3" align="center" height="22">
  
<tr align="center" valign="middle">
   
<td align="left">
    
<input type="file" name="file1" style="width:350px" value="">
    
<input type="submit" value="上传">
   
</td>
  
</tr>
 
</table>
</form>
</body>
</html>

 

保存上传文件的uploadSave.asp

 

ContractedBlock.gif ExpandedBlockStart.gif uploadSave
<!--#include file="upload_wj.asp"-->
<meta http-equiv="Content-Type" content="text/html; charSet=gb2312">
<style type="text/css">
<!--
* {font-size:12px;}
-->
</style>
<%
DisableOutSite  
'禁从站外进入
uploadSave



Sub DisableOutSite()
  
Dim server_v1,server_v2
  server_v1
=Cstr(Request.ServerVariables("HTTP_REFERER"))
  server_v2
=Cstr(Request.ServerVariables("SERVER_NAME"))
  
If mid(server_v1,8,len(server_v2))<>server_v2 Then response.Redirect("/")
  
If instr(request.servervariables("http_referer"),"http://"&request.servervariables("host") )<1 Then response.Redirect("/")
End Sub




Sub uploadSave
  
Dim upload,filepath,filelx,rename,formName
  
Dim fileExt,ranNum,filename,todb_filename,i,upfile
  
Set upload= New upload_file
  
If upload.form("act")<>"uploadfile" Then
    
Set upload = Nothing
    
Exit Sub
  
End If

  filepath      
= trim(upload.form("filepath"))
  filelx           
= trim(upload.form("filelx"))
  sizeName   
= trim(upload.form("sizeName"))
  rename       
= trim(upload.form("rename"))
  fileNameElement 
= trim(upload.form("editName"))

  i
=0
  
For Each formName In upload.File
    
Set upfile=upload.File(formName)
    fileExt
=lcase(upfile.FileExt) '得到的文件扩展名不含有.
    If upfile.fileSize<100 Then
      response.write 
"<span>请先选择你要上传的文件! [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
      
Exit Sub
    
End If
    
'--------检查文件扩展名
    If (filelx<>"swf"and (filelx<>"jpg"and (filelx<>"doc"Then
      response.write 
"<span>该文件类型不能上传! [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
      response.end
    
End If
    
If filelx="swf" Then
      
If fileext<>"swf"  and (fileext<>"rm"and (fileext<>"ram"and (fileext<>"wmv"and (fileext<>"asf"Then
        response.write 
"<span>只能上传swf/rm/ram/wmv/asf文件! [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
        response.end
      
End If
    
End If
    
If filelx="doc" Then
      
If fileext<>"doc"  and fileext<>"pdf" and fileext<>"zip" and fileext<>"rar"  Then
       response.write 
"<span>只能上传doc,pdf,zip,rar格式文件! [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
       response.end
      
End If
    
End If
    
If filelx="jpg" Then
      
If fileext<>"gif" and fileext<>"jpg" and fileext<>"png" And fileExt<>"bmp" Then
        response.write 
"<span>上传图片类型错误! [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
        response.end
      
End If
    
End If
    
'--------检查文件扩展名

    
'--------检查大小是否超过限制
    Dim maxSize
    
Select Case filelx
      
Case "jpg","swf" : maxSize = 3000*1024
      
Case Else  : maxSize = 2000*1024
    
End Select
    
If upfile.filesize>maxSize Then
      response.write 
"<span>文件大小超过限制 [ <a href=""javascript:history.go(-1);"">重新上传</a> ]</span>"
      response.end
    
End If
    
'//--------检查大小是否超过限制
    '--------处理重新命名上传文件的情况
    If rename="" Then
      
randomize
      ranNum
=int(90000*rnd)+10000
      filename
=filepath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt '程序写入的完整的路径及文件名
      todb_filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt  '写入数据库的文件名
    Else
      filename
=filepath&rename '程序写入的完整的路径及文件名
      todb_filename=rename  '写入数据库的文件名
    End If
    
'//--------处理重新命名上传文件的情况
    If upfile.FileSize>0 Then         ''如果 FileSize > 0 说明有文件数据
      upfile.SaveToFile Server.mappath(FileName)
      
Call ChkHackWord(FileName)

      
'response.write upfile.FileName&"  上传成功!  <br>"
      'response.write "新文件名:"&FileName&"<br>"
      'response.write "新文件名已复制到所需的位置,可关闭窗口!"
      oFrm =  upload.form("FormName")
      
If filelx="swf" Then
        response.write 
"<script>parent.document."& oFrm &".size.value='"&int(upfile.FileSize/1024)&" K'</script>"
      
End If
      
If sizeName<>"" Then
        response.write 
"<script>parent.document."& oFrm &"."& sizeName &".value='"& int(upfile.FileSize/1024)&" KB'</script>"
      
End If
      response.write 
"<script>parent.document."& oFrm &"."& fileNameElement &".value='"&todb_FileName&"'</script>"
    
End If
    
Set upfile=nothing
  
Next
  
Set upload=nothing
  %
>
  
<script language="javascript">window.alert("文件上传成功!请不要修改生成的链接地址!");</script>
<%
End Sub
%
>

 

uploadSave.asp中使用无惧无组件上传类 :

 

ContractedBlock.gif ExpandedBlockStart.gif upload_wj.asp
<%
'----------------------------------------------------------------------
'
转发时请保留此声明信息,这段声明不并会影响你的速度!
'
*******************    无组件上传类   ********************************
'
修改者:梁无惧
'
电子邮件:yjlrb@21cn.com
'
网站:http://www.25cn.com
'
原作者:稻香老农
'
原作者网站:http://www.5xsoft.com
'
声明:此上传类是在化境编程界发布的无组件上传类的基础上修改的.
'
在与化境编程界无组件上传类相比,速度快了将近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
%
>

转载于:https://www.cnblogs.com/s1ihome/archive/2008/11/18/1336061.html

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
无组件ASP文件上传代码 记得在建立一个文件夹"updata" saveannounce_upload.asp 上传页 ------------------------------------ body {font-size:9pt;} input {font-size:9pt;} 文件上传 文件 ------------------------------------ saveannouce_upfile.asp 保存文件到服务器 ------------------------------------ 文件上传 <% dim upload,file,formName,formPath set upload=new upload_5xSoft ''建立上传对象 formPath=upload.form("filepath") ''在目录后加(/) if right(formPath,1)"/" then formPath=formPath&"/" for each formName in upload.file ''列出所有上传了的文件 set file=upload.file(formName) ''生成一个文件对象 if file.filesize<100 then response.write "请先选择你要上传的文件 [ 重新上传 ]" response.end end if if file.filesize>500*1000 then '设置上传文件大小为500K response.write "文件大小超过了限制 500K [ 重新上传 ]" response.end end if if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据 file.SaveAs Server.mappath("updata\"&file.FileName) ''保存文件 end if set file=nothing next set upload=nothing response.write "文件上传成功 [ 继续上传 ]" %> ------------------------------------ upload.inc 建立upload对象 ------------------------------------ dim upfile_5xSoft_Stream Class upload_5xSoft dim Form,File,Version Private Sub Class_Initialize dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr Version="" if Request.TotalBytes<1 then Exit Sub set Form=CreateObject("Scripting.Dictionary") set File=CreateObject("Scripting.Dictionary") set upfile_5xSoft_Stream=CreateObject("Adodb.Stream") upfile_5xSoft_Stream.mode=3 upfile_5xSoft_Stream.type=1 upfile_5xSoft_Stream.open upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes) vbEnter=Chr(13)&Chr(10) iDivLen=inString(1,vbEnter)+1 strDiv=subString(1,iDivLen) iFormStart=iDivLen iFormEnd=inString(iformStart,strDiv)-1 while iFormStart 0 and iFileNameStartiStart then mFileSize=iEnd-iStart-4 else mFileSize=0 end if set theFile=new FileInfo theFile.FileName=getFileName(mFileName) theFile.FilePath=getFilePath(mFileName) theFile.FileSize=mFileSize theFile.FileStart=iStart+4 theFile.FormName=FormName file.add mFormName,theFile else iStart=inString(iEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFormValue=subString(iStart+4,iEnd-iStart-4) else mFormValue="" end if form.Add mFormName,mFormValue end if iFormStart=iformEnd+iDivLen iFormEnd=inString(iformStart,strDiv)-1 wend End Sub Private Function subString(theStart,theLen) dim i,c,stemp upfile_5xSoft_Stream.Position=theStart-1 stemp="" for i=1 to theLen if upfile_5xSoft_Stream.EOS then Exit for c=ascB(upfile_5xSoft_Stream.Read(1)) If c > 127 Then if upfile_5xSoft_Stream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Private Function inString(theStart,varStr) dim i,j,bt,theLen,str InString=0 Str=toByte(varStr) theLen=LenB(Str) for i=theStart to upfile_5xSoft_Stream.Size-theLen if i>upfile_5xSoft_Stream.size then exit Function upfile_5xSoft_Stream.Position=i-1 if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then InString=i for j=2 to theLen if upfile_5xSoft_Stream.EOS then inString=0 Exit for end if if AscB(upfile_5xSoft_Stream.Read(1))AscB(MidB(Str,j,1)) then InString=0 Exit For end if next if InString0 then Exit Function end if next End Function Private Sub Class_Terminate form.RemoveAll file.RemoveAll set form=nothing set file=nothing upfile_5xSoft_Stream.close set upfile_5xSoft_Stream=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 toByte(Str) dim i,iCode,c,iLow,iHigh toByte="" For i=1 To Len(Str) c=mid(Str,i,1) iCode =Asc(c) If iCode255 Then iLow = Left(Hex(Asc(c)),2) iHigh =Right(Hex(Asc(c)),2) toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh) Else toByte = toByte & chrB(AscB(c)) End If Next End function End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=1 if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function if FileStart=0 or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open upfile_5xSoft_Stream.position=FileStart-1 upfile_5xSoft_Stream.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=0 end function End Class
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值