最简单的文件上传代码

三个页:选择页,上传页sub.asp,调用的代码页upload.inc

 1、浏览上传:

< form action = " sub.asp "  method = " post "  enctype = " multipart/form-data "  target = " _self " >  
< input type = " file "  name = " src "  size = " 20 "  value = " 浏览 " >  
< input type = " submit "  value = " 上传 "  name = " B1 "  IsShowProcessBar = " True " >  
</ form >  

 

2、sub.asp 执行上传并返回地址,同时保存文件名在session(ccc)中:

< ! -- #include FILE = " upload.inc " -->  
<
dim  upload,file,formName,formPath,iCount,fileformat 
set  upload = new  upload_F 
function  MakedownName() 
dim  fname 
fname 
=   now () 
fname 
=   replace (fname, " - " , ""
fname 
=   replace (fname, "   " , ""
fname 
=   replace (fname, " : " , ""
fname 
=   replace (fname, " PM " , ""
fname 
=   replace (fname, " AM " , ""
fname 
=   replace (fname, " 上午 " , ""
fname 
=   replace (fname, " 下午 " , ""
fname 
=   int (fname)  +   int (( 10 - 1 + 1 ) * Rnd   +   1
MakedownName
= fname 
end function  
formPath
= " upload/ "  
iCount
= 0  
for   each  formName in upload.file  ' '列出所有上传了的文件 
set  file = upload.file(formName)  ' '生成一个文件对象 

fileformat
= lcase ( right (file.filename, 4 )) 

if  fileformat = " .asp "   or  fileformat = " .htm "   then  
response.write
" <script>alert('文件格式不对,请重新上传!');location=' " & request.ServerVariables( " HTTP_REFERER " ) & " '</script> "  
response.end 
end   if  

if  file.FileSize > 0   then   ' '如果 FileSize > 0 说明有文件数据 
newname = MakedownName() & " . " & mid (file.FileName, InStrRev (file.FileName,  " . " ) + 1

session(
" ccc " ) = newname 
file.SaveAs Server.mappath(formPath
& newname)  ' '保存文件 
iCount = iCount + 1  
else  
response.write 
" <font style=FONT-SIZE:9pt>未找到文件 <A HREF=javascript:history.back(1)>重新上传</A><font style=FONT-SIZE:9pt> "  
response.end 
end   if  
next  
%
>  


<
response.write 
" <a href='upload/ " & newname & " ' target=_blank>upload/ " & newname & "  </a>( " & cint (file.FileSize / 1024 ) & " K) 上传成功! "  
%
>  

<
set  file = nothing  
set  upload = nothing   ' '删除此对象 
% >  

 

3、upload.inc 页的代码如下:

< SCRIPT RUNAT = SERVER LANGUAGE = VBSCRIPT >  

dim  upfile_Stream 

Class upload_F 

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
= " upload Version 1.0 "  
if  Request.TotalBytes < 1   then   Exit   Sub  
set  Form = CreateObject ( " Scripting.Dictionary "
set  File = CreateObject ( " Scripting.Dictionary "
set  upfile_Stream = CreateObject ( " Adodb.Stream "
upfile_Stream.mode
= 3  
upfile_Stream.type
= 1  
upfile_Stream.open 
upfile_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  <  iFormEnd 
iStart
= inString(iFormStart, " name="" "
iEnd
= inString(iStart + 6 , " "" "
mFormName
= subString(iStart + 6 ,iEnd - iStart - 6
iFileNameStart
= inString(iEnd + 1 , " filename="" "
if  iFileNameStart > 0   and  iFileNameStart < iFormEnd  then  
iFileNameEnd
= inString(iFileNameStart + 10 , " "" "
mFileName
= subString(iFileNameStart + 10 ,iFileNameEnd - iFileNameStart - 10
iStart
= inString(iFileNameEnd + 1 ,vbEnter & vbEnter) 
iEnd
= inString(iStart + 4 ,vbEnter & strDiv) 
if  iEnd > iStart  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_Stream.Position
= theStart - 1  
stemp
= ""  
for  i = 1   to  theLen 
if  upfile_Stream.EOS  then   Exit   for  
c
= ascB(upfile_Stream.Read( 1 )) 
If  c  >   127   Then  
if  upfile_Stream.EOS  then   Exit   for  
stemp
= stemp & Chr (AscW(ChrB(AscB(upfile_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_Stream.Size - theLen 
if  i > upfile_Stream.size  then   exit   Function  
upfile_Stream.Position
= i - 1  
if  AscB(upfile_Stream.Read( 1 )) = AscB(midB(Str, 1 ))  then  
InString
=
for  j = 2   to  theLen 
if  upfile_Stream.EOS  then  
inString
= 0  
Exit   for  
end   if  
if  AscB(upfile_Stream.Read( 1 )) <> AscB(MidB(Str,j, 1 ))  then  
InString
= 0  
Exit   For  
end   if  
next  
if  InString <> 0   then   Exit   Function  
end   if  
next  
End Function  

Private   Sub  Class_Terminate 
form.RemoveAll 
file.RemoveAll 
set  form = nothing  
set  file = nothing  
upfile_Stream.close 
set  upfile_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  iCode < 0   Then  iCode  =  iCode  +   65535  
If  iCode > 255   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_Stream.position
= FileStart - 1  
upfile_Stream.copyto dr,FileSize 
dr.SaveToFile FullPath,
2  
dr.Close 
set  dr = nothing  
SaveAs
= 0  
end function  
End  Class 
</ SCRIPT >
HttpUploader4全面升级了文件IO组件。新的IO组件在处理磁盘中的文件时,将不必再对文件执行I/O操作,这意味着在对文件进行处理时将不必再为文件申请并分配缓存,所有的文件缓存操作均由系统直接管理,由于取消了将文件数据加载到内存、数据从内存到文件的回写以及释放内存块等步骤,使得HttpUploader4在处理TB级数据时能够拥有闪电般的速度。 新的IO组件赋予了HttpUploader4更强的大数据处理能力。现在HttpUploader4在对GB级文件进行MD5校验时速度提高了4倍。同时CPU占用率更低。 HttpUploader4更加注重对硬盘的保护,在HttpUploader4中不再直接对文件进行I/O操作,而是在内存中对文件进行操作,所以不仅极大的减少了对硬盘的读写次数,同时速度却变的更快了。 借助于HttpUploader4企业能够帮助用户更加轻松的处理工作中的文件,让用户与用户之间的沟通更加的高效。从根本上提高企业竞争力。 考虑到不同的企业使用的开发平台不同,我们已经为企业开发人员提供了完整的与数据库相结合的示例(ASP.NET,JSP,PHP)。开发人员能够非常容易的在自已的系统中实现断点续传功能。 产品特点如下: 1. 为TB级文件提供稳定传输功能。 2. 优化MD5组件,文件扫描速度提升70%。 3. 保护磁盘,上传超大文件时,磁盘IO次数降低50%。 4. 采用全新设计IO组件,上传任意文件大小时始终占用128KB内存。 5. 支持文件及文件夹拖拽上传功能。 6. 支持文件批量上传。 7. 支持文件夹上传。 8. 基于标准HTTP协议。 9. 免费提供JavaScript SDK包,方便您将插件快速集成到已有网站中。 支持语言:PHP,JSP,ASP,ASP.NET(C#),ASP.NET(VB),C++,VC,VC.NET,VB,VB.NET,C#,C#.NET,Delphi,C++Builder 支持平台:Visual Studio 6.0/2002/2003/2005/2008/2010,C++ Builder 6.0/2009/2010,Delphi 7/2009,Visual Basic 6.0/2008,MyEclipse8.x 支持脚本:JavaScript,VBScript 支持服务器:Windows NT,Windows 2003,Windows XP,Windows Vista,Windows 7,Linux,Unix 支持浏览器:IE6,IE7,IE8,360安全浏览器,QQ浏览器,搜狐浏览器,Maxthon(遨游)浏览器1.X,Maxthon(傲游)浏览器2.x 支持文件大小:2G~8EB(1EB=102PB,1PB=1024TB,1TB=1024GB) 支持文件类型:任意类型 版权所有 2009-2012 武汉命运科技有限公司 保留所有权利 官方网站:http://www.ncmem.com/ 产品首页:http://www.ncmem.com/webplug/http-uploader3/index.aspx 在线演示:http://www.ncmem.com/products/http-uploader3/demo/index.html 产品介绍:http://www.cnblogs.com/xproer/archive/2012/05/29/2523757.html 开发文档-ASP:http://www.cnblogs.com/xproer/archive/2012/02/17/2355458.html 开发文档-PHP:http://www.cnblogs.com/xproer/archive/2012/02/17/2355467.html 开发文档-JSP:http://www.cnblogs.com/xproer/archive/2012/02/17/2355462.html 开发文档-ASP.NET:http://www.cnblogs.com/xproer/archive/2012/02/17/2355469.html 升级日志:http://www.cnblogs.com/xproer/archive/2012/02/17/2355449.html 资源下载:cab安装包,开发文档, 示例下载(ASP.NET):ASP.NET-ACCESS示例 示例下载(JSP):JSP-ACCESS示例(GB2312),JSP-ACCESS示例(UTF-8),JSP-Sql2005示例(UTF-8),JSP-MySQL示例(UTF-8) 示例下载(PHP):MySQL示例(UTF-8) 问题反馈:http://www.ncmem.com/bbs/showforum-4.aspx VC运行库:http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=29 联系信箱:1085617561@qq.com 联系QQ:1085617561
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值