最简单的文件上传代码

三个页：选择页，上传页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 = i 
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 >