ASP文件上传神功 第二重（招势图加内功心法） (转)

ASP文件上传神功 第二重（招势图加内功心法） (转)[@more@]

第二重：文本信息与图片文件同时提交保存到数据库
图片文件也可保存到磁盘文件

　　这个问题已经不是什么新鲜问题了，网上也有大把的教程，但大多数是授人以鱼，而不授人以渔，经过辛苦的资料收集，思考，调试，整理，我基本上已经把这个问题从原理上搞清楚了，现在根据我自己的理解，在范例程序的基础上，加以解释，希望能对部分网友（比我还菜的:-)）有所帮助。

　　请诸位大虾能对其中的不正或不良这处予以指正。

　　程序中stream对象的用法上参考了“化境HTTP上传程序 Version 2.0”在代码，在此对稻香老农和梁无惧表示衷心的感谢和由衷的敬意。

　　上次讲了单个图片文件保存到数据库，这次讲一下文本信息与图片文件同时提交保存到数据库，图片文件也可保存到磁盘文件。

MultiInputOrImageToData.ASP
vbscript %>

　'把一段二进制数据写入到一个文件
　sub saveBin2File(srmsource,posB,posLen,strPath)
　　dim srmObj
　　set srmObj = server.Createobject("adodb.stream")
　　srmObj.Type = 1
　　srmObj.Mode = 3
　　srmObj.Open
　　　
　　srmSource.Position = posB-1
　　srmSource.CopyTo srmObj,posLen
　　srmObj.Position = 0
　　srmObj.SaveToFile strPath,2　　　'如果该文件已经存在，无条件覆盖
　　srmObj.Close
　　set srmObj = nothing
　end sub

　'二进制数据转换为字符串，包括汉字
　function getTextfromBin(srmSource,posBegin,posLen)
　　dim srmObj, strData
　　set srmObj = server.CreateObject("adodb.stream")
　　srmObj.Type = 1
　　srmObj.Mode = 3
　　srmObj.Open

　　srmSource.position = posBegin-1　　　'位置计数首数不一样，这个对象是对0开始的
　　srmSource.CopyTo srmObj,posLen
　　srmObj.Position = 0
　　srmObj.Type = 2
　　srmObj.Charset = "gb2312"
　　strData = srmObj.ReadText

　　srmObj.Close
　　set srmObj = nothing
　　　
　　getTextfromBin = strData
　end function
　　　　
　'双字节字符串转换成单字节字符串
　function getSBfromDB(bytString)
　　dim bin, i
　　bin = ""
　　for  i=1 to len(bytString)
　　　bin = bin & chrb(asc(mid(bytString,i,1)))
　　next
　　getSBfromDB = bin
　end function

　'单字节字符串转换成双字节字符串
　function getDBfromSB(bitString)
　　dim str, i
　　str = ""
　　for i=1 to lenb(bitString)
　　　str = str & chr(ascb(midb(bitString,i,1)))
　　next
　　getDBfromSB = str
　end function
　
　'从一个完整路径中析出文件名称
　function getFileNamefromPath(strPath)
　　getFileNamefromPath = mid(strPath,instrrev(strPath,"")+1)
　end function

　'判断函数
　function iif(cond,expr1,expr2)
　　if cond then
　　　iif = expr1
　　else
　　　iif = expr2
　　end if
　end function
　
　'定义数据库连接字符串
　dim cnstr
　cnstr = "driver={microsoft Access Driver (*.mdb)};dbq=" & server.MapPath("./UPLOAD.mdb")
%>

　

　　多个表单域或图像同步保存到数据库
　　
　
　

导航菜单：上传图片　显示图片

---

　
　if request.ServerVariables("REQUEST_METHOD") = "POST" then

　　dim SCOme, binData
　　dim posB, posE, posSB, posSE
　　dim binCrlf, binSub
　　dim strTitle, strFileName, strContentType, posfileBegin, posFileLen, aryFileInfo
　　dim i, j
　　dim dicData
　　dim strName,strValue
　　
　　binCrlf = getSBfromDB(vbcrlf)　　'定义一个单字节的回车换行符
　　binSub = getSBfromDB("--")　　　　'定义一个单字节的“--”字符串
　　
　　set sCome = server.CreateObject("adodb.stream")
　　sCome.Type = 1　　'指定返回数据类型 adTypeBinary=1,adTypeText=2
　　sCome.Mode = 3　　'指定打开模式 adModeRead=1,adModeWrite=2,adModeReadWrite=3
　　sCome.Open
　　sCome.Write request.BinaryRead(request.TotalBytes)
　　
　　sCome.Position = 0
　　binData = sCome.Read
　　'response.BinaryWrite binData　　　　'调试用：显示提交的所有数据
　　'response.Write "

---

"　　　　　　　'调试用
　　
　　posB = instrb(binData,binSub)
　　posB = instrb(posB,binData,bincrlf) + 2　　　'+2是加入回车换行符本身的长度
　　posB = instrb(posB,binData,getSBfromDB("name=""")) + 6
　　
　　set dicData = server.CreateObject("scripting.dictionary")　　　　'用来保存信息
　　
　　do until posB=6
　　　posE = instrb(posB,binData,getSBfromDB(""""))
　　　'Response.Write "name=" & getTextfromBin(sCome,posB,posE-posB) & "
"
　　　strName = getTextfromBin(sCome,posB,posE-posB)
　　　
　　　posB = posE + 1　　　　　'指针移动到“"”的后面
　　　posE = instrb(posB,binData,bincrlf)
　　　'Response.Write posB & "->" & posE & "
"
　　
　　　if instrb(midb(binData,posB,posE-posB),getSBfromDB("filename=""")) > 0 then　　　'判断成功表示这是一个file域
　　　　posB = instrb(posB,binData,getSBfromDB("filename=""")) + 10
　　　　posE = instrb(posB,binData,getSBfromDB(""""))
　　　　if posE>posB then
　　　　　'response.Write "filename=" & getTextfromBin(sCome,posB,posE-posB) & "
"
　　　　　strFileName = getFileNamefromPath(getTextfromBin(sCome,posB,posE-posB))
　　　　　posB = instrb(posB,binData,getSBfromDb("Content-Type:")) + 14
　　　　　posE = instrb(posB,binData,bincrlf)
　　　　　'response.Write "content-type=" & getTextfromBin(sCome,posB,posE-posB) & "
"
　　　　　strContentType = getTextfromBin(sCome,posB,posE-posB)

　　　　　posB = posE + 4　　　　　'这个地方换了两行，具体参看输出的原始二进制数据
　　　　　posE = instrb(posB,binData,binSub)
　　　　　'response.Write "image data="
　　　　
　　　　　'saveBin2File sCome,posB,posE-posB-1,server.MapPath("./") & "test.jpg"
　　　　　'Response.Write "
"
　　　　　posFileBegin = posB
　　　　　posFileLen = posE-posB-1
　　　　　strValue = strFileName & "," & strContentType & "," & posFileBegin & "," & posFileLen
　　　　else
　　　　　'Response.Write "没有上传文件！" & "
"
　　　　　strValue = ""
　　　　end if
　　　else
　　　　posB = posE + 4　　　　　'这个地方换了两行，具体参看输出的原始二进制数据
　　　　posE = instrb(posB,binData,binCrlf)
　　　　'Response.Write "value=" & getTextfromBin(sCome,posB,posE-posB) & "
"　　'这个后面没有“"”，所以不用-1
　　　　strValue = getTextfromBin(sCome,posB,posE-posB)
　　　end if
　　
　　　dicData.Add strName,strValue
　　　
　　　posB = posE + 2
　　
　　　posB = instrb(posB,binData,bincrlf) + 2
　　　posB = instrb(posB,binData,getSBfromDB("name=""")) + 6
　　loop
　　
　　strTitle = dicData.Item("txtTitle")
　　aryFileInfo = dicData.Item("filImage")
　　if aryFileInfo <> "" then　　　　　　　　　'有文件数据上传
　　　aryFileInfo = split(aryFileInfo,",")
　　　strFileName = aryFileInfo(0)
　　　strContentType = aryFileInfo(1)
　　　posFileBegin = aryFileInfo(2)
　　　posFileLen = aryFileInfo(3)
　　　
　　　sCome.Position = posFileBegin-1
　　　binData = sCome.Read(posFileLen)
　　　　　　　　
　　　dim cn, rs, sql
　　　set cn = server.CreateObject("adodb.connection")
　　　cn.Open cnstr
　　　set rs = server.CreateObject("adodb.recordset")
　　　sql = "select title,[content-type],image from tblImage2"
　　　rs.Open sql,cn,1,3
　　　rs.AddNew
　　　rs.Fields("title").Value = strTitle
　　　rs.Fields("content-type").Value = strContentType
　　　
　　　'数据保存到数据库
　　　rs.Fields("image").AppendChunk binData

　　　'如果数据以文件形式保存到磁盘上，用下面这句
　　　'saveBin2File sCome,posFileBegin,posFileLen,server.MapPath("./") & strFileName

　　　rs.Update
　　　rs.Close
　　　set rs = nothing
　　　cn.Close
　　　set cn = nothing
　　　
　　　Response.Write "

文件保存成功！

"
　　else
　　　Response.Write "

没有上传文件！

"
　　end if
　　
　　sCome.Close
　　set sCome = nothing　　
　else
%>
　　RM id="frmUpload" name="frmUpload" action="" method="post" target="_self" enctype="multipart/form-data">
　　　

标题：

　　　

图片：

　　　
　　
　end if
%>
　

待续...

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-997871/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-997871/