求助 大侠帮忙看一下不能实现下载
我想做一个资源共享系统 实现文件上传下载 能上传不能下载（也能删除） 代码如下：帮忙看看<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.
<html xmlns="http://www.
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>无标题文档</title>
</head>
<body>
<%
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")
= 1
Set File = Server.CreateObject ("Scripting.Dictionary")
= 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
%>
<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>
同时上传4个相同的文件，就看到效果了<br /><form action="upload.asp" method="post" enctype="multipart/form-data">
文件1 <input type="file" name="file1" /> <br />
文件2 <input type="file" name="file2" /> <br />
文件3 <input type="file" name="file3" /> <br />
文件4 <input type="file" name="file4" /> <br /><input type="submit" value="上传" />
</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=downloadfile&filename="&filenamecode&">DL</a>")
Response.write("</td>")
Response.write("</tr>")
Response.write("</table>")
Next
End sub
%>
</body>
</html>
大侠
