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