[共享]上传文件代码
前几天一直在搜寻上传文件的代码，可是都很少遇到合适的，所以改了改，与诸君共享！（其中具体上传的部分代码，我也不是太懂，愿和大家一块儿讨论下）邮箱：[email=xiaobai40510@]xiaobai40510@[/email]<% '注意这里的应用！
Response.Buffer = True
Server.ScriptTimeOut=9999999
On Error Resume Next
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "[url=http://www.]http://www.[/url]">
<html xmlns="[url=http://www.]http://www.[/url]">
<head>
<meta http-equiv="Content-Type" c />
<meta http-equiv="Content-Language" c />
<meta c name="robots" />
<title>上传文件</title>
<script language="Javascript"> //检查上传的文件是否为空！
<!--
function ValidInput()
{
if(document.form1.upfile.value=="")
{
alert("请选择上传文件！")
document.form1.upfile.focus()
return false
}
return true
}
-->
</script>
</head>
<body id="body">
<form name="form1" action='<%= Request.ServerVariables("URL") %>' method='post' enctype="multipart/form-data">
<%
SavePath="upload/"
ExtName = "jpg,gif,bmp,chm,exe,png,txt,rar,zip,doc,htm,html" '允许扩展名
If Right(SavePath,1)<>"/" Then SavePath=SavePath&"/" '在目录后加(/)
CheckAndCreateFolder(SavePath)
UpLoadAll_a = Request.TotalBytes '取得客户端全部内容
If(UpLoadAll_a>0) Then
Set UploadStream_c = Server.CreateObject("ADODB.Stream")
UploadStream_c.Type = 1 'adtypebinary=1 adtypetext=2
UploadStream_c.Open
UploadStream_c.Write Request.BinaryRead(UpLoadAll_a)
UploadStream_c.Position = 0
FormDataAll_d = UploadStream_c.Read
CrLf_e = chrB(13)&chrB(10)
FormStart_f = InStrB(FormDataAll_d,CrLf_e)
FormEnd_g = InStrB(FormStart_f+1,FormDataAll_d,CrLf_e)
Set FormStream_h = Server.Createobject("ADODB.Stream")
FormStream_h.Type = 1
FormStream_h.Open
UploadStream_c.Position = FormStart_f + 1
UploadStream_c.CopyTo FormStream_h,FormEnd_g-FormStart_f-3
FormStream_h.Position = 0
FormStream_h.Type = 2
FormStream_h.CharSet = "GB2312"
FormStreamText_i = FormStream_h.Readtext
FormStream_h.Close
FileName_j = Mid(FormStreamText_i,InstrRev(FormStreamText_i,"\")+1,FormEnd_g)
If(CheckFileExt(FileName_j,ExtName)) Then
SaveFile = Server.MapPath(SavePath & FileName_j)
If Err Then
Response.Write "文件上传： <span style=""color:red;"">文件上传出错!</span> <a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
Err.Clear
Else
SaveFile = CheckFileExists(SaveFile)
k=Instrb(FormDataAll_d,CrLf_e&CrLf_e)+4
l=Instrb(k+1,FormDataAll_d,leftB(FormDataAll_d,FormStart_f-1))-k-2
FormStream_h.Type=1
FormStream_h.Open
UploadStream_c.Position=k-1
UploadStream_c.CopyTo FormStream_h,l
FormStream_h.SaveToFile SaveFile,2
SaveFileName = Mid(SaveFile,InstrRev(SaveFile,"\")+1)
uptime=now()
'//写入到数据库
database="data.mdb"
db="provider=microsoft.jet.oledb.4.0; provider="&server.MapPath(database)
set conn=server.CreateObject("adodb.connection")
conn.open db
set rs=server.CreateObject("adodb.recordset")
sql="select * from file"
rs.open sql,conn,1,2
rs.addnew
rs("fileName")=SaveFileName
rs("uptime")=uptime
rs("contentlen")=UpLoadAll_a/1024
rs.update
set rs=nothing
conn.close
set conn=nothing
'传递成功
Response.write "文件上传成功，文件路径："& SavePath &"" & SaveFileName & "<br><br><a href="""& Request.ServerVariables("URL")&""">继续上传文件</a> "
End If
Else
Response.write "<script>alert('文件格式不正确,上传失败!');location.replace('upload.asp')</script>"
End If
Else
%>
<table align="center">
<tr>
<td>文件上传</td>
</tr>
<tr>
<td>选择文件：</td>
<td><input name="upfile" type="file"></td>
</tr>
<tr>
<td>
<input type="submit" name="Submit" value="上传">
<input type="reset" name="Submit2" value="重置">
</td>
</tr>
</table>
<%
End if
Set FormStream_h = Nothing
UploadStream.Close
Set UploadStream = Nothing
%>
</form>
</body>
</html>
<%
'判断文件类型是否合格
Function CheckFileExt(FileName,ExtName) '文件名,允许上传文件类型
FileType = ExtName
FileType = Split(FileType,",")
For i = 0 To Ubound(FileType)
If LCase(Right(FileName,3)) = LCase(FileType(i)) then '将扩展名与可以上传的文件的扩展名进行比较
CheckFileExt = True
Exit Function
Else
CheckFileExt = False
End if
Next
End Function
'检查上传文件夹是否存在，不存在则创建文件夹
Function CheckAndCreateFolder(FolderName)
dim fldr
fldr = Server.Mappath(FolderName)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fldr) Then
fso.CreateFolder(fldr)
End If
Set fso = Nothing
End Function
'检查文件是否存在，重命名存在文件
Function CheckFileExists(FileName)
Set fso=Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SaveFile) Then
i=1
flag=True
Do While flag
CheckFileExists = Replace(SaveFile,Right(SaveFile,4),"_" & i & Right(SaveFile,4))
'判断，如果存在相同的文件名的话，将其文件名的最后四位前加_
If not fso.FileExists(CheckFileExists) Then
flag=False
End If
i=i+1
Loop
Else
CheckFileExists = FileName
End If
Set fso=Nothing
End Function
%>
支持共享
