用asp实现文件浏览、上传、下载的程序

可以放在服务器上，对服务器上的文件进行浏览、上传、下载，可下载文件源码。 
把下所有代码入在一个文件里即可，文件的后缀要为asp。 

复制代码代码如下:

<%  
thedir = request("thedir")  
if thedir = "" then  
 folderini = server.mappath(".")&"\"  
else  
 folderini = server.mappath(thedir)&"\"  
end if  

foldinfo=trim(Request.Querystring("foldinfo"))  
if foldinfo = "" then  
 foldinfo = folderini  
end if  

class clsUp  
Dim Form,File  
Dim AllowExt_   
Dim NoAllowExt_   
Private oUpFileStream   
Private isErr_    
Private ErrMessage_   
Private isGetData_   

Public Property Get Version  
 Version="v1.0.0"  
End Property  

Public Property Get isErr  
 isErr=isErr_  
End Property  

Public Property Get ErrMessage  
 ErrMessage=ErrMessage_  
End Property  

Public Property Get AllowExt  
 AllowExt=AllowExt_  
End Property  

Public Property Let AllowExt(Value)   
 AllowExt_=LCase(Value)  
End Property  

Public Property Get NoAllowExt  
 NoAllowExt=NoAllowExt_  
End Property  

Public Property Let NoAllowExt(Value)  
 NoAllowExt_=LCase(Value)  
End Property  

Private Sub Class_Initialize  
 isErr_ = 0  
 NoAllowExt=""    
 NoAllowExt=LCase(NoAllowExt)  
 AllowExt=""    
 AllowExt=LCase(AllowExt)  
 isGetData_=false  
End Sub  

Private Sub Class_Terminate   
 on error Resume Next  

 Form.RemoveAll  
 Set Form = Nothing  
 File.RemoveAll  
 Set File = Nothing  
 oUpFileStream.Close  
 Set oUpFileStream = Nothing  
End Sub  

Public Sub GetData (MaxSize)  

 on error Resume Next  
 if isGetData_=false then   
  Dim getupdata1,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo  
  Dim sFormValue,sFileName  
  Dim iFindStart,iFindEnd  
  Dim iFormStart,iFormEnd,sFormName  

  If Request.TotalBytes < 1 Then   
   isErr_ = 1  
   ErrMessage_=""  
   Exit Sub  
  End If  
  If MaxSize > 0 Then   
   If Request.TotalBytes > MaxSize Then  
   isErr_ = 2   
   ErrMessage_=""  
   Exit Sub  
   End If  
  End If  
  Set Form = Server.CreateObject ("Scripting.Dictionary")  
  Form.CompareMode = 1  
  Set File = Server.CreateObject ("Scripting.Dictionary")  
  File.CompareMode = 1  
  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  
  getupdata1 = oUpFileStream.Read   
  iFormEnd = oUpFileStream.Size  
  bCrLf = ChrB (13) & ChrB (10)  

  sSpace = MidB (getupdata1,1, InStrB (1,getupdata1,bCrLf)-1)  
  iStart = LenB(sSpace)  
  iFormStart = iStart+2  

  Do  
   iInfoEnd = InStrB (iFormStart,getupdata1,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,getupdata1,sSpace)-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 clsFileInfo  

    iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10  
    iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,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.FileMIME = 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  
    If Form.Exists (sFormName) Then  
     Form (sFormName) = Form (sFormName) & ", " & sFormValue  
     else  
     Form.Add sFormName,sFormValue  
    End If  
   End If  
   tStream.Close  
   iFormStart = iFormStart+iStart+2  

  Loop Until (iFormStart+2) >= iFormEnd   
  getupdata1 = ""  
  Set tStream = Nothing  
  isGetData_=true  
 end if  
End Sub  

Public Function SaveToFile(Item,Path)  
 SaveToFile=SaveToFileEx(Item,Path,True)  
End Function  

Public Function AutoSave(Item,Path)  
 AutoSave=SaveToFileEx(Item,Path,false)  
End Function  

Private Function SaveToFileEx(Item,Path,Over)  
 On Error Resume Next  
 Dim oFileStream  
 Dim tmpPath  
 Dim nohack  
 isErr=0  
 Set oFileStream = CreateObject ("ADODB.Stream")  
 oFileStream.Type = 1  
 oFileStream.Mode = 3  
 oFileStream.Open  
 oUpFileStream.Position = File(Item).FileStart  
 oUpFileStream.CopyTo oFileStream,File(Item).FileSize  
 nohack=split(path,".")  
 tmpPath=nohack(0)&"."&nohack(ubound(nohack))  
 if Over then  
  if isAllowExt(GetFileExt(tmpPath)) then  
   oFileStream.SaveToFile tmpPath,2  
   Else  
   isErr_=3  
   ErrMessage_="!"  
  End if  
 Else  
  Path=GetFilePath(Path)  
  if isAllowExt(File(Item).FileExt) then  
   do  
    Err.Clear()  
    nohack=split(Path&GetNewFileName()&"."&File(Item).FileExt,".")   
    tmpPath=nohack(0)&"."&nohack(ubound(nohack))  
    oFileStream.SaveToFile tmpPath  
   loop Until Err.number<1  
   oFileStream.SaveToFile Path  
   Else  
   isErr_=3  
   ErrMessage_="该后缀名的文件不允许上传!"  
  End if  
 End if  
 oFileStream.Close  
 Set oFileStream = Nothing  
 if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)  
End Function  

'取得文件数据  
Public Function FileData(Item)  
 isErr_=0  
 if isAllowExt(File(Item).FileExt) then  
  oUpFileStream.Position = File(Item).FileStart  
  FileData = oUpFileStream.Read (File(Item).FileSize)  
  Else  
  isErr_=3  
  ErrMessage_=""  
  FileData=""  
 End if  
End Function  

Public function GetFilePath(FullPath)  
  If FullPath <> "" Then  
    GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))  
    Else  
    GetFilePath = ""  
  End If  
End function  

Public Function GetFileName(FullPath)  
  If FullPath <> "" Then  
    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)  
    Else  
    GetFileName = ""  
  End If  
End function  

Public Function GetFileExt(FullPath)  
  If FullPath <> "" Then  
    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))  
    Else  
    GetFileExt = ""  
  End If  
End function  

Public Function GetNewFileName()  
 dim ranNum  
 dim dtNow  
 dtNow=Now()  
 ranNum=int(90000*rnd)+10000  
 GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum  
End Function  

Public Function isAllowExt(Ext)  
 if NoAllowExt="" then  
  isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))  
 else  
  isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))  
 end if  
End Function  
End Class  

Class clsFileInfo  
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt  
End Class  
%>  

<%  

function deletefile(filename)  
 set objfilesys=server.createobject("scripting.filesystemobject")  
 ss=filename  
 ss=foldinfo&ss  
 if objfilesys.FILEExists(ss) then  
 objfilesys.deleteFILE ss  
 end if  
end function  

function deletedir(dirname)  
 set objfilesys=server.createobject("scripting.filesystemobject")  
 ss=dirname&idd  
 ss=server.mappath(ss)  
 if objfilesys.FOLDERExists(ss) then  
 objfilesys.deleteFOLDER ss  
 end if  
end function  

function download(filename)  
 Response.Buffer = true    
 Response.Clear    

 dim  url    
 Dim  fso,fl,flsize    
 dim  Dname    
 Dim  objStream,ContentType,flName,isre,url1    

 Dname=filename    

 If  Dname<>""  Then    
  url=foldinfo&Dname  
 End  If    

 Set fso=Server.CreateObject("Scripting.FileSystemObject")    
 Set fl=fso.getfile(url)    
 flsize=fl.size    
 flName=fl.name    
 Set fl=Nothing    
 Set fso=Nothing    

 Set objStream=Server.CreateObject("ADODB.Stream")    
 objStream.Open    
 objStream.Type=1    
 objStream.LoadFromFile url    

 ContentType="text/html"    

 Response.AddHeader  "Content-Disposition","attachment;filename="&flName    
 Response.AddHeader  "Content-Length",  flsize    
 Response.Charset  =  "UTF-8"    
 Response.ContentType  =  ContentType    
 Response.BinaryWrite  objStream.Read    
 Response.Flush    
 response.Clear()    
 objStream.Close  
 Set objStream = Nothing    
end function  

function uploadfiles()  
filepath=foldinfo    
set upload=new clsUp   
upload.NoAllowExt="aep"  
upload.GetData (3072000)  

if upload.form("act")="uploadfile" then  
 for each formName in upload.File  
  set file=upload.File(formName)  
  randomize  
  filename1=file.FileName  
  filename=filepath&filename1  

  if file.FileSize>0 then  
   upload.SaveToFile formName,FileName  
  end if  
  set file=nothing  
 next  
 set upload=nothing  
end if  
end function  


action = request("action")  
if action = "deletefile" then  
 filename = request("filename")  
 deletefile(filename)  
end if  

if action = "deletedir" then  
 deletedirname = request("deletedir")  
 deletedir(deletedirname)  
end if  

if action = "download" then  
 filename = request("filename")  
 download(filename)  
end if  

if action = "uploadfiles" then  
 uploadfiles()  
end if  
%>  

<html>  
<head>  
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">  
</head>  
<body>  
<table>  
  <tr>  
    <td><font>当前目录:</font><font color="#FF7120"><%=foldinfo%></font>  

    <form name="form1" method="post" action="?foldinfo=<%=foldinfo%>&action=uploadfiles" enctype="multipart/form-data">  
        <input type="hidden" name="act" value="uploadfile">  
        <input type="file" name="file1" style="width:300'" class="tx1" value="">  
        <input type="submit" name="Submit" value="上传" class="button">  
  </form>  

    </td>  
  </tr>  
  <tr>  
    <td>   
      <hr size="1">  
    </td>  
  </tr>  
  <tr>  
    <td>   
      <table width="750" border="0" cellspacing="1" cellpadding="1">  
        <tr bgcolor="#00CC00">   
          <td width="300" >Folder</td>  
          <td width="180" >Size</td>  
          <td width="200" >LastTime</td>  
          <td width="100" >Operate</td>  
        </tr>  
      </table>  
    </td>  
  </tr>  
  <tr>   
    <td align="right" >   
      <%  
            upfolder=left(foldinfo,len(foldinfo)-1)  
            upfolder=left(upfolder,InstrRev(upfolder, "\"))  
            if foldinfo<>folderini then   
        response.write("<a href='?foldinfo="&upfolder&"'>Go Back</a>")  
        else   
        response.write("Go Back")  
        end if%>  
    </td>  
  </tr>  
  <tr>   
    <td >   
      <% ShowFolderList(foldinfo) %>  
    </td>  
  </tr>  
  <tr>   
    <td >   
      <table width="750" border="0" cellspacing="1" cellpadding="1">  
        <tr bgcolor="#009999">   
          <td width="300">File</td>  
          <td width="180">Size</td>  
          <td width="200">LastTime</td>  
          <td width="100">Operate</td>  
        </tr>  
      </table>  
    </td>  
  </tr>  
  <tr>   
    <td >   
      <% showfolderinfo(foldinfo)%>  
    </td>  
  </tr>  
  <tr>   
    <td> </td>  
  </tr>  
</table>  
<%  
Sub ShowFolderList(folderspec)  
    Dim fs, f, f1, fc, s, schild,p,fsize  
    Set fs = CreateObject("scripting.FileSystemObject")  
    Set f = fs.GetFolder(folderspec)  
    Set fc = f.SubFolders  
    For Each f1 in fc  
            s = f1.name  
            's = s &  vbCrLf  
        p = f1.DateLastModified  
        fsize = f1.Size  
            schild=folderspec&s&"\"  

Response.write("<table width='750' border='0' cellspacing='1' cellpadding='1'>")  
Response.write("<tr>")  
Response.write("<td width='300' bgcolor='#ECFFD9'><font face='Wingdings' font size='3pt'>0</font><a href='?foldinfo="&schild&"'>"&s&"</a></td>")  
Response.write("<td width='180' bgcolor='#ECFFD9'>"&fsize&"</td>")  
Response.write("<td width='200' bgcolor='#ECFFD9'>"&p&"</td>")  
Response.write("<td width='100' bgcolor='#ECFFD9'>")  
Response.write("<a href=?foldinfo="&foldinfo&"&action=deletedir&deletedir="&s&">DEL</a>")  
Response.write("</td>")  

Response.write("</tr>")  
Response.write("</table>")  

    Next  
End Sub  

Sub showfolderinfo(folderspc)  
set MyFileObject=Server.CreateObject("scripting.FileSystemObject")  


Set MyFolder=MyFileObject.GetFolder(folderspc)  

for each thing in MyFolder.Files  
    Set afile=MyFileObject.GetFile(thing)  
    filenamecode=afile.name  
    filedetail=folderspc+filenamecode  
    filedetail=replace(filedetail,"\","*s_p_l_i_t*")  
    filesize=afile.size  
    lastmodify=afile.DateLastModified  

Response.write("<table width='750' border='0' cellspacing='1' cellpadding='1'>")  
Response.write("<tr>")  
Response.write("<td width='300' bgcolor='#f4f4ff'><font face='Wingdings' font size='3pt'>2</font>"&filenamecode&"</td>")  
Response.write("<td width='180' bgcolor='#f4f4ff'>"&filesize&"</td>")  
Response.write("<td width='200' bgcolor='#f4f4ff'>"&lastmodify&"</td>")  
Response.write("<td width='100' bgcolor='#f4f4ff'>")  
Response.write("<a href=?foldinfo="&foldinfo&"&action=deletefile&filename="&filenamecode&">DEL</a> ")  
Response.write("<a href=?foldinfo="&foldinfo&"&action=download&filename="&filenamecode&">DL</a>")  
Response.write("</td>")  
Response.write("</tr>")  
Response.write("</table>")  
Next  
End sub  
%>  
</body>  
</html>