< % Response.Buffer = True Server.ScriptTimeOut = 9999999 On Error Resume Next % > < !DOCTYPE html PUBLIC " -//W3C//DTD XHTML 1.0 Transitional//EN " " http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd " > < html xmlns = " http://www.w3.org/1999/xhtml " > < head > < meta http - equiv = " Content-Type " content = " text/html; charset=gb2312 " /> < meta http - equiv = " Content-Language " content = " zh-cn " /> < meta content = " all " name = " robots " /> < meta name = " author " content = "" /> < meta name = " description " content = " ASP文件上传工具 " /> < meta name = " keywords " content = " ASP,Upload,文件上传 " /> < style type = " text/css " > < ! -- body, input {font - size:12px;} --> </ style > < title > ASP文件上传工具 </ title > </ head > < body id = " body " > < % ExtName = " jpg,gif,png,txt,rar,zip,doc " ' 允许扩展名 SavePath = " upload " ' 保存路径 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 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 ) Response.write " 文件上传: <span style=""color:red;""> " & SaveFileName & " </span>文件上传成功! <a href="" " & Request.ServerVariables( " URL " ) & " "">继续上传文件</a><br /> " End If Else Response.write " 文件上传: <span style=""color:red;"">文件格式不正确!</span> <a href="" " & Request.ServerVariables( " URL " ) & " "">重新上传文件</a><br /> " End If Else % > < script language = " Javascript " > < ! -- Function ValidInput() function ValidInput(){ if(document.upform.upfile.value=="") { alert("请选择上传文件!") document.upform.upfile.focus() return false } return true}// --></script><form action='<%= Request.ServerVariables("URL") %>' method='post' name="upform" οnsubmit="return ValidInput()" enctype="multipart/form-data">文件上传:<input type='file' name='upfile' size="40"> <input type='submit' value="上传"></form><% End if Set FormStream_h = Nothing UploadStream.Close Set UploadStream = Nothing%></body></html><% '判断文件类型是否合格 Function CheckFileExt()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()Function CheckAndCreateFolder(FolderName) 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()Function CheckFileExists(FileName) Set fso=Server.CreateObject("Scripting.FileSystemObject") If fso.FileExists(SaveFile) Then i=1 msg=True Do While msg CheckFileExists = Replace(SaveFile,Right(SaveFile,4),"_" & i & Right(SaveFile,4)) If not fso.FileExists(CheckFileExists) Then msg=False End If i=i+1 Loop Else CheckFileExists = FileName End If Set fso=NothingEnd Function%>