当前位置:asp编程网>技术教程>Asp教程>  正文

asp无组件文件上传

2007-11-14 17:37:55   来源:本站原创    作者:佚名   浏览量:2488   收藏
文件上传组件:upload.asp
<% 
  Dim stream1,stream2,istart,iend,filename
  istart=1
  vbEnter=Chr(13)&#38;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 &#38; chrB("&#38;H"&#38;iLow) &#38; chrB("&#38;H"&#38;iHigh) 
   Else 
     toByte = toByte &#38; 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&#38;Chr(AscW(ChrB(AscB(objStream.Read(1)))&#38;ChrB(c))) 
    i=i+1 
   else 
    stemp=stemp&#38;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>
 &#38;nbsp;&#38;nbsp;标题<input type="text" name="filename"><br>
 <input type="submit" value="提交">
 </form>
 </BODY>
</HTML>


uploadfile.asp
<!--#include file="upload.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 "文件名:"&#38;path&#38;"  标题:"&#38;name
' response.End

End if
%>

关于我们-广告合作-联系我们-积分规则-网站地图

Copyright(C)2013-2017版权所属asp编程网