asp无组件文件上传-Asp-技术教程-asp编程网

文件上传组件：upload.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)
'CheckFileExt(fstr)'''''''''''''''''''''''''''''''''''''''''''''''''''''''
    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
%>

1.html
<HTML>
<HEAD>
  <TITLE> 图片和文本一同上传 </TITLE>
</HEAD>
<style>
body {font-size:12px;}
</style>
<BODY>
    <form action="uploadfile.asp" method="post" enctype="multipart/form-data" name="form1">
文件路径<input type="file" name="filepath"><br>
&nbsp;&nbsp;标题<input type="text" name="filename"><br>
<input type="submit" value="提交">
</form>
</BODY>
</HTML>

uploadfile.asp

<%
if Request.TotalBytes>0 then
set objstream=server.CreateObject("adodb.stream")
objstream.Mode=3
objstream.Type=1
objstream.Open
objstream.Write Request.BinaryRead(Request.TotalBytes)

path=getvalue("filepath",false,"pic/")     'pic为当前目录下一个文件夹名,也可以改成../pic,即上层目录中的pic文件夹
name=getvalue("filename",true,"")
response.write "文件名："&path&"  标题:"&name
' response.End

End if
%>

asp无组件文件上传

最新相关教程

热门教程

推荐教程