<%
Dim FormData,FormSize,DataStart,CLStr,DivStr
FormSize=Request.TotalBytes'上传文件的大小
FormData=Request.BinaryRead(FormSize)'上传文件的二进制数据
IF FormSize < 2500289 Then'限制2.5M以下
If FormSize<>0 Then
ExtName = "jpg,gif,txt,zip,doc,rar,xls"    '允许扩展名
Dim Contenta,Contentb,Contentc

SavePath = "jpg\"'保存文件路径
response.Write("接收到的数据大小="&FormSize&"字节<br>")
CLStr=ChrB(13)&ChrB(10)'以回车和换行符为分隔符
divider=leftB(FormData,clng(instrb(FormData,CLStr))-1)'取得分隔符divider

'在程序中直接调用该函数就可获得所需文件（或文本框）内容，如下所示：
Contenta=getdata (FormData, divider, FormSize,"a")'返回数据段说明字段(二进制)
Contentb=getdata (FormData, divider, FormSize,"b")'返回数据(二进制)
Contentc=getdata (FormData, divider, FormSize,"c")'返回表单内容(二进制)第1段
'获取文件名
filesa=BtoS(Contenta)'文件信息转化为字符
ffil=inStrRev(filesa,"\")'从右边起查找\
ffila=inStr(filesa,"\")'从左边起查找 \
toll=len(filesa)'文件名长度
Response.Write("文件长度:"& lenb(Contentb) &"字节<br>")
if ffil<>0 then'有上传文件
ffiles=mid(filesa,ffil 1,len(filesa)-inStrRev(filesa,"\")-1)'提取文件名
If (CheckFileExt(ffiles,ExtName)) Then'检查文件扩展名
 If Err Then'上传是否出错
        Response.Write "文件上传： 文件上传出错!</span>　<a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
        Err.Clear
     Response.End()
      Else'上传未出错
SavePath=CheckAndCreateFolder(SavePath)
Dpath=Server.MapPath(SavePath)
Dpath=mid(Dpath,1,inStrRev(Dpath,"\"))
fullpath=Dpath&SavePath&ffiles'设置完整文件路径
sdk=Instrb(FormData,CLStr&CLStr) 4'开始位置
Si=lenb(Contentb)'上传数据长度
'Si=Instrb(sdk 1,FormData,Instrb(sdk,FormData,divider))
'Response.write("fullpath="&fullpath &"<br>")
 Set ffso = Server.CreateObject("Scripting.FileSystemObject")
'Response.Write(ffso.FileExists(fullpath))
 If ffso.FileExists(fullpath) Then
'调用检查文件是否重名函数,如重名自动换名。不在同一目录用完整路径
    fullpath=CheckFileExists(fullpath)
    Response.Write("文件"&ffiles&"已存在!!!重名名文件名并上传"&"<br>")
 ffiles=mid(fullpath,inStrRev(fullpath,"\") 1,len(fullpath)-InStrRev(fullpath,"\"))
Response.Write("新文件名："&ffiles&"<br>")
   Else
'   fullpath=CheckFileExists(fullpath)
   Response.Write("文件"""&ffiles&"""不存在继续上传"&"<BR>")
   End If
'Response.write("fullpath="&fullpath &"<br>")
'Response.Write("FileExists="&(ffso.FileExists(fullpath))&"<br>")
  set ffso=Nothing
  Response.Write("<br>")
'如果上传的文件不为空文件(文件长度大于0字节)则进行上传。
if Si>0  then '数据不为空
  set str=server.CreateObject("ADODB.Stream") 'str为源数据流
  str.Mode=3 '设置打开模式，3为可读可写
  str.Type=1 '设置数据类型，1为二进制数据
  str.Open
  set desc=server.CreateObject("ADODB.Stream") 'desc为目标数据流
  desc.Mode=3
  Desc.Type=1
  desc.Open
  str.Write FormData'Contentc ' 赋值源数据流
  str.Position=sdk-1'sdk-1指出文件的开始位置
  str.CopyTo desc,Si' Si表示文件的长度
desc.SaveToFile fullpath ,2 '以fullpath指定的路径及名称保存文件2表示执行覆盖原有文件

  Desc. Close
  Set desc=nothing
  Str. Close
  Set STR=nothing
End If'数据不为空
End If'上传是否出错
SaveFileName = Mid(fullpath,InstrRev(fullpath,"\") 1)
Response.write "<span style=""color:red;"">" & SaveFileName & " </span>文件上传成功!　<a href=""" & Request.ServerVariables("URL") &""">继续上传文件</a><br />"
Response.End()
else'文件扩展名不正确
Response.Write("文件"""&ffiles&"""扩展名不符合要求,检查文件扩展名!!!<br>")
Response.write "<span style=""color:red;"">文件格式不正确!</span>　<a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
Response.End()
end if''检查文件扩展名
end if'有上传文件

End If
else
Response.write "<span style=""color:red;"">文件大小超过 XX M!</span>　<a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
Response.End()
End If
%>
<%
'自定义函数2个
Function BtoS (bstr) '二进制转换成字符
If not IsNull(bstr) Then
 for i = 0 to lenb(bstr) - 1
 bchr = midb(bstr,i 1,1)
  If ascb(bchr)>127 Then '汉字是双字节，得两个字符一起处理
  temp = temp&chr(ascw(midb(bstr, i 2, 1)&bchr))
  i = i 1
  Else
  temp = temp&chr(ascb(bchr))
  End If
 next
End If
BtoS = temp
End Function

'获得文件（或文本框）内容
'在实际的WEB应用中，上传操作可能涉及多项内容，如多个文本框、多个文件等等。文件和文本框很好区分,
'文件的数据中包含了"filename="字串。因此，我们写了如下的通用函数，既可用于提取文件内容,又可提取文本框内容（需进行二进制转换）：
Function getdata(byval data, byval divider, final, xu) 'data表示二进制串；divider表示分割符；final表示数据的结束位置
'xu=a反说明段xu=b反文件内容xu=c反表单内容
filename=chrb(102)&chrb(105)&chrb(108)&chrb(101)&chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34) '字符串"filename"的二进制表示
bncrlf=chrb(13)&chrb(10) '二进制的回车符
startpos = instrb(data,divider) lenb(divider) lenb(bncrlf) ' 开始位置
endpos = instrb(startpos,data, divider)-lenb(bncrlf) '结束位置
endpose= instrb(endpos lenb(divider),data,divider)-lenb(bncrlf)'表单后的分隔符
part1 = midb(data, startpos, endpos-startpos) '两个分割符之间的内容：说明及文件内容两部分
part2 = midb(data, endpos lenb(divider) lenb(bncrlf),endpose-endpos-lenb(divider))'表单内容
firstline = midb(part1, 1, instrb(part1, bncrlf)-1) ' 内容之前的说明段
If xu="a" then
Getdata=firstline'返回说明段
Else
 if xu="b" then
  If (instrb(firstline,filename)=0) Then '若为文本框，获得文本框字符串内容
   stemp=midb(part1,instrb(part1,bncrlf&bncrlf) lenb(bncrlf&bncrlf),lenb(part1)-instrb(part1,bncrlf&bncrlf) lenb(bncrlf&bncrlf))
   getdata=BtoS(stemp)
   Else '若为文件，获得文件二进制内容
    Getdata=midb(part1,instrb(part1, bncrlf&bncrlf) lenb (bncrlf&bncrlf), lenb (part1)-instrb(part1,bncrlf&bncrlf) lenb(bncrlf&bncrlf))
   End If
  else
   If xu="c" then
     Getdata=part2'反表单内容
  else
   end if
 end if
End If
Final=endpos
End function

'判断文件类型是否合格
  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)
    fldr = Server.Mappath(FolderName)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fldr) Then
      fso.CreateFolder(fldr)
    End If
 CheckAndCreateFolder=FolderName
    Set fso = Nothing
  End Function
'检查文件是否存在，重命名存在文件
Function CheckFileExists(FileName)
  Set fso=Server.CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(FileName) Then'SaveFile) Then
    i=1
    msg=True
    Do While msg
      CheckFileExists = Replace(FileName,Right(FileName,4),"_" & i & Right(FileName,4))
      If Not fso.FileExists(CheckFileExists) Then
        msg=False
      End If
      i=i 1
    Loop
  Else
    CheckFileExists = FileName
  End If
  Set fso=Nothing
End Function

%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>ASP上传文件</title>
</head>

<body>
<form action="filup.asp" method="post" enctype="multipart/form-data" name="form1">
<table>
  <tr><td valign="middle" headers="35"><span style="color:red;">文件大小不能超过 1 M否则无法完成上传</span></td></tr>
<tr><td>  <input type="file" name="file"><input name="提交" type="submit" value="提交">
      </td></tr>
  <tr><td></td></tr>
  </table>
</form>
</body>
</html>