【下载文档:  用asp实现文件浏览、上传、下载的程序.txt 】

---

用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 %>

当前目录:<%=foldinfo%>

Folder Size LastTime Operate

<% upfolder=left(foldinfo,len(foldinfo)-1) upfolder=left(upfolder,InstrRev(upfolder, "\")) if foldinfo<>folderini then response.write("Go Back") else response.write("Go Back") end if%>

<% ShowFolderList(foldinfo) %>

File Size LastTime Operate

<% showfolderinfo(foldinfo)%>

<% 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("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("

0"&s&"

"&fsize&"

"&p&"

") Response.write("DEL") Response.write("

") 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("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("") Response.write("

2"&filenamecode&"

"&filesize&"

"&lastmodify&"

") Response.write("DEL ") Response.write("DL") Response.write("

") Next End sub %>