ASP无组件上传(返回表单值,插入数据库)

因为要返回到表单页,所以比较麻烦,需要4个文件(包括表单页).
1,upload.inc(核心文件,采用稻香老农)
程序代码 程序代码
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

dim upfile_5xSoft_Stream

Class upload_5xSoft  

dim Form,File,Version  

Private Sub Class_Initialize

           dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile

           dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr

           Version=""

           if Request.TotalBytes<1 then Exit Sub

           set Form=CreateObject("Scripting.Dictionary")

           set File=CreateObject("Scripting.Dictionary")

           set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")

           upfile_5xSoft_Stream.mode=3

           upfile_5xSoft_Stream.type=1

           upfile_5xSoft_Stream.open

           upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)        

           vbEnter=Chr(13)&Chr(10)

           iDivLen=inString(1,vbEnter)+1

           strDiv=subString(1,iDivLen)

           iFormStart=iDivLen

           iFormEnd=inString(iformStart,strDiv)-1

           while iFormStart < iFormEnd

             iStart=inString(iFormStart,"name=""")

             iEnd=inString(iStart+6,"""")

             mFormName=subString(iStart+6,iEnd-iStart-6)

             iFileNameStart=inString(iEnd+1,"filename=""")

             if iFileNameStart>0 and iFileNameStart<iFormEnd then

              iFileNameEnd=inString(iFileNameStart+10,"""")

              mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)

              iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)

              iEnd=inString(iStart+4,vbEnter&strDiv)

              if iEnd>iStart then

               mFileSize=iEnd-iStart-4

              else

               mFileSize=0

              end if

              set theFile=new FileInfo

              theFile.FileName=getFileName(mFileName)

              theFile.FilePath=getFilePath(mFileName)

              theFile.FileSize=mFileSize

              theFile.FileStart=iStart+4

              theFile.FormName=FormName

              file.add mFormName,theFile

             else

              iStart=inString(iEnd+1,vbEnter&vbEnter)

              iEnd=inString(iStart+4,vbEnter&strDiv)

        

              if iEnd>iStart then

               mFormValue=subString(iStart+4,iEnd-iStart-4)

              else

               mFormValue=""

              end if

              form.Add mFormName,mFormValue

             end if

        

             iFormStart=iformEnd+iDivLen

             iFormEnd=inString(iformStart,strDiv)-1

           wend

End Sub

Private Function subString(theStart,theLen)

dim i,c,stemp

upfile_5xSoft_Stream.Position=theStart-1

stemp=""

for i=1 to theLen

      if upfile_5xSoft_Stream.EOS then Exit for

      c=ascB(upfile_5xSoft_Stream.Read(1))

      If c > 127 Then

       if upfile_5xSoft_Stream.EOS then Exit for

       stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))

       i=i+1

      else

       stemp=stemp&Chr(c)

      End If

Next

subString=stemp

End function

Private Function inString(theStart,varStr)

dim i,j,bt,theLen,str

InString=0

Str=toByte(varStr)

theLen=LenB(Str)

for i=theStart to upfile_5xSoft_Stream.Size-theLen

      if i>upfile_5xSoft_Stream.size then exit Function

      upfile_5xSoft_Stream.Position=i-1

      if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then

       InString=i

       for j=2 to theLen

         if upfile_5xSoft_Stream.EOS then

           inString=0

           Exit for

         end if

         if AscB(upfile_5xSoft_Stream.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

Private Sub Class_Terminate  

     form.RemoveAll

     file.RemoveAll

     set form=nothing

     set file=nothing

     upfile_5xSoft_Stream.close

     set upfile_5xSoft_Stream=nothing

End Sub

Private function GetFilePath(FullPath)

     If FullPath <> "" Then

      GetFilePath = left(FullPath,InStrRev(FullPath, "\"))

     Else

      GetFilePath = ""

     End If

End     function

Private function GetFileName(FullPath)

     If FullPath <> "" Then

      GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)

     Else

      GetFileName = ""

     End If

End     function

Private 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

End Class

Class FileInfo

     dim FormName,FileName,FilePath,FileSize,FileStart

     Private Sub Class_Initialize

       FileName = ""

       FilePath = ""

       FileSize = 0

       FileStart= 0

       FormName = ""

     End Sub  

Public function SaveAs(FullPath)

       dim dr,ErrorChar,i

       SaveAs=1

       if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function

       if FileStart=0 or right(fullpath,1)="/" then exit function

       set dr=CreateObject("Adodb.Stream")

       dr.Mode=3

       dr.Type=1

       dr.Open

       upfile_5xSoft_Stream.position=FileStart-1

       upfile_5xSoft_Stream.copyto dr,FileSize

       dr.SaveToFile FullPath,2

       dr.Close

       set dr=nothing

       SaveAs=0

     end function

End Class

</SCRIPT>

2,表单页面index.asp。注意框架包含的上传选择页upload.asp
程序代码 程序代码
<form name="form_name" method="POST" action="add.asp">
<textarea cols="100" name="cn_content" rows="18" width="100%"></textarea>
</form>
<iframe border="0" frameBorder="0" noResize scrolling="no" width="100%" src="upload.asp"></iframe>

3,上传选择页upload.asp 注意: enctype="multipart/form-data"
程序代码 程序代码
<form name="form" method="post" action="upfile.asp" enctype="multipart/form-data">
<input type="hidden" name="filepath" value="uploadimg">
<input type="hidden" name="act" value="upload">
<input type="file" name="file1" size=40>
<input type="submit" class=button name="Submit" value="上传图片" onclick="parent.document.forms[0].Submit.disabled=true">类型:gif,jpg,限制:100K
</form>

4,最后一 个文件 upfile.asp 主要作用:生成图片名,并将图片上传,同样也要将UBB标签写入index.asp中的textarea中。

程序代码 程序代码
<!--#include file="upload.inc"-->

<html>

<head>

<title>文件上传</title>

</head>

<body>

<script>

parent.document.forms[0].Submit.disabled=false;

</script>

<%

dim upload,file,formName,formPath,iCount,filename,fileExt

set upload=new upload_5xSoft ''建立上传对象

formPath=upload.form("filepath")

''在目录后加(/)

if right(formPath,1)<>"/" then formPath=formPath&"/"

response.write "<body>"

iCount=0

for each formName in upload.file ''列出所有上传了的文件

set file=upload.file(formName)     ''生成一个文件对象

if file.filesize<100 then

        response.write "请选择你要上传的文件 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"

       response.end

end if

    

if file.filesize>100*1000 then

        response.write "文件大小超过了限制100K [ <a href=# onclick=history.go(-1)>重新上传</a> ]"

       response.end

end if

fileExt=lcase(right(file.filename,4))

uploadsuc=false

Forum_upload="gif,jpg,png"

Forumupload=split(Forum_upload,",")

for i=0 to ubound(Forumupload)

       if fileEXT="."&trim(Forumupload(i)) then

       uploadsuc=true

       exit for

       else

       uploadsuc=false

       end if

next

if uploadsuc=false then

        response.write "文件格式不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"

       response.end

end if

randomize

ranNum=int(90000*rnd)+10000

filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt

if file.FileSize>0 then            ''如果 FileSize > 0 说明有文件数据

     file.SaveAs Server.mappath(FileName)      ''保存文件

       for i=0 to ubound(Forumupload)

           if fileEXT="."&trim(Forumupload(i)) then

            response.write "<script>parent.form_name.cn_content.value+='"&FileName&"'</script>"

           exit for

           end if

       next

iCount=iCount+1

end if

set file=nothing

next

set upload=nothing     ''删除此对象

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)

set upload=nothing

response.write "上传成功 [ <a href=# onclick=history.go(-1)>继续上传</a>]"
response.end
end sub
%>
</body>
</html>

当然,保持图片的文件夹uploadimg不能少


[本日志由 刚子 于 2011-03-22 03:35 AM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志:
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵 称:
密 码: 游客发言不需要密码.
内 容:
验证码: 验证码
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.
t