很好的上传！无组件！文件上传！包含其他文本字段！文件自动更名！简单易用！

领测软件测试网 其中部分代码根据化境代码改编！！
upload.htm
<html>

<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>New Page 1</title>
<link rel="stylesheet" href="../public/css.css">
</head>
<script language="javascript">
<!--
function checkform1()
  {

  if (form1.names.value=="")
    {
    alert("请输入名称！")
    form1.names.focus()
    return false
    }
  if (form1.pic.value=="")
    {
    alert("请选择图片！")
    form1.pic.focus()
    return false
    }
  return true
  }

//-->
</script>
<body>

<table border="0" width="100%">
<form name="form1" enctype="multipart/form-data" action="upload.asp" method="post" onsubmit="return checkform1()">
  <tr>
    <td width="100%" colspan="2">
      <p align="center"><b>上传示例</b></td>
  </tr>
  
  <tr>
    <td width="40%" align="right">名称：</td>
    <td width="60%"><input type="text" name="names" size="30" maxlength="20" class="input1"></td>
  </tr>
  <tr>
    <td width="40%" align="right">图样：</td>
    <td width="60%"><input type="file" name="pic" size="30" maxlength="20" class="input1"  onblur="document.all.picview.src=document.all.pic.value"></td>
  </tr>
  
  <tr>
    <td width="40%" align="right">　</td>
    <td width="60%"><input  type="submit" value="   o k   " class="inputbtn"></td>
  </tr>
  <tr>
    <td width="100%" align="center" colspan="2">
    图象预览（选择图片后，点击页面任意处即可进行预览)<br>
    <img id="picview" border="1">
    </td>
    
  </tr>
  </form>
</table>

</body>

</html>


-----upload.asp
<!--#include file="savefile.asp"-->
<%
Set objStream = Server.CreateObject("ADODB.Stream")
  
  objstream.mode=3
  objStream.Type = 1
  objStream.Open
  
  objstream.write Request.BinaryRead(Request.TotalBytes)
  
  names= getvalue("names",true,"")
  
  pic=getvalue("pic",false,"upimg/")
  

objstream.close
response.write("names:"+names)
response.write ("文件已上传!("+pic+")")
%>


-----savefile.asp
<%
  Dim stream1,stream2,istart,iend,filename
  istart=1
  vbEnter=Chr(13)&Chr(10)

function getvalue(fstr,foro,paths)‘’fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径
  if foro then
    getvalue=""
    istart=instring(istart,fstr)

    istart=istart+len(fstr)+5
    iend=instring(istart,vbenter+"-----------------------------")
    if istart>5+len(fstr) then
    getvalue=substring(istart,iend-istart)
   
    else
    getvalue=""
    end if
    else
    istart=instring(istart,fstr)
    istart=istart+len(fstr)+13
    iend=instring(istart,vbenter)-1
    
    filename=substring(istart,iend-istart)
    filename=getfilename(filename)
  
    istart=instring(iend,vbenter+vbenter)+3
    iend=instring(istart,vbenter+"-----------------------------")
    filestart=istart
    filesize=iend-istart-1
    objstream.position=filestart
    Set sf = Server.CreateObject("ADODB.Stream")
    sf.Mode=3
    sf.Type=1
    sf.Open
    objstream.copyto sf,FileSize
    
    if filename<>"" then
    Set rf = Server.CreateObject("Scripting.FileSystemObject")
    i=0
    fn=filename
    while rf.FileExists(server.mappath(paths+fn))

      fn=cstr(i)+filename
      i=i+1
      wend
    filename=fn
    sf.SaveToFile server.mappath(paths+filename),2
    end if
    getvalue=filename
    end if
  
end function

Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
End  function


Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to objStream.Size-theLen
   if i>objstream.size then exit Function
   
   objstream.Position=i-1
   if AscB(objstream.Read(1))=AscB(midB(Str,1)) then
    InString=i
    for j=2 to theLen
      if objstream.EOS then  
        inString=0
        Exit for
      end if
      if AscB(objstream.Read(1))<>AscB(MidB(Str,j,1)) then
        InString=0
        Exit For
      end if
    next
    if InString<>0 then Exit Function
   end if
next
End Function


function toByte(Str)
   dim i,iCode,c,iLow,iHigh
   toByte=""
   For i=1 To Len(Str)
   c=mid(Str,i,1)
   iCode =Asc(c)
   If iCode<0 Then iCode = iCode + 65535
   If iCode>255 Then
     iLow = Left(Hex(Asc(c)),2)
     iHigh =Right(Hex(Asc(c)),2)
     toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
   Else
     toByte = toByte & chrB(AscB(c))
   End If
   Next
End function

Function subString(theStart,theLen)
dim i,c,stemp
objStream.Position=theStart-1
stemp=""
for i=1 to theLen
   if objStream.EOS then Exit for
   c=ascB(objStream.Read(1))
   If c > 127 Then
    if objStream.EOS then Exit for
    stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))
    i=i+1
   else
    stemp=stemp&Chr(c)
   End If
Next
subString=stemp
End function
%>


呵呵！希望大家喜欢！

文章来源于领测软件测试网 https://www.ltesting.net/