主题:各位?在ASP中什么样编写上传图形的程序?
hy590
[专家分:0] 发布于 2003-08-11 23:24:00
各位?在ASP中什么样编写上传图形的程序?
沙发
木头人 [专家分:0] 发布于 2003-08-12 12:14:00
getfile.htm
< html>
< head>
< title>
保存图片到数据库< /title>
< /head>
< body>
< b>
< p>
< /b>
你可以找个图片试试,保存完毕后会有提示< /p>
< form METHOD="POST" ENCTYPE="multipart/form-data" ACTION="savetodb.asp">
< p>
Email : < input NAME="email" VALUE="wangcq@sina.com" size="20">
< br>
Picture : < input TYPE="file" NAME="blob">
< br>
< input TYPE="submit" NAME="Enter">
< /p>
< /form>
< /body>
< /html>
savetodb.asp
----------------------------------
< % Response.Buffer = TRUE Response.Clear byteCount = Request.TotalBytes RequestBin = Request.BinaryRead(byteCount) Dim UploadRequest Set UploadRequest = CreateObject("Scripting.Dictionary") BuildUploadRequest RequestBin email = UploadRequest.Item("email").Item("Value") contentType = UploadRequest.Item("blob").Item("ContentType") filepathname = UploadRequest.Item("blob").Item("FileName") filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"")) picture = UploadRequest.Item("blob").Item("Value") 'Response.ContentType = contentType 'Response.binaryWrite picture set objCn = server.createobject("adodb.connection") set objRst = server.createobject("adodb.recordset") objCn.Open "upload" objrst.Open "pic", objcn, 1,3,2 objrst.addnew objrst.fields("filename")=filename objrst.fields("type")="gif" objrst.fields("what").appendchunk picture objrst.update response.write "< a href=showpic.asp?id=" & objrst("id") & ">
第" & objrst("id") & "个图片。< /a>
" objrst.close objCn.close set objrst=nothing set objcn = nothing %>
< !--#include file="upload.asp"-->
showpic.asp
----------------------------------------
< % set objCn = server.createobject("adodb.connection") set objRst = server.createobject("adodb.recordset") objCn.Open "upload" objrst.Open "select what from pic where id=" & request("id"), objcn if not objrst.eof then response.binarywrite objrst("what") end if objrst.close objCn.close set objrst=nothing set objcn = nothing %>
upload.asp
-------------------------------------------
< % Sub BuildUploadRequest(RequestBin) 'Get the boundary PosBeg = 1 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13))) boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg) boundaryPos = InstrB(1,RequestBin,boundary) 'Get all data inside the boundaries Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--"))) 'Members variable of objects are put in a dictionary object Dim UploadControl Set UploadControl = CreateObject("Scripting.Dictionary") 'Get an object name Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition")) Pos = InstrB(Pos,RequestBin,getByteString("name=")) PosBeg = Pos+6 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34))) Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)) PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename=")) PosBound = InstrB(PosEnd,RequestBin,boundary) 'Test if object is of file type If PosFile< >
0 AND (PosFile< PosBound) Then 'Get Filename, content-type and content of file PosBeg = PosFile + 10 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34))) FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)) 'Add filename to dictionary object UploadControl.Add "FileName", FileName Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:")) PosBeg = Pos+14 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13))) 'Add content-type to dictionary object ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)) UploadControl.Add "ContentType",ContentType 'Get content of object PosBeg = PosEnd+4 PosEnd = InstrB(PosBeg,RequestBin,boundary)-2 Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg) Else 'Get content of object Pos = InstrB(Pos,RequestBin,getByteString(chr(13))) PosBeg = Pos+4 PosEnd = InstrB(PosBeg,RequestBin,boundary)-2 Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)) End If 'Add content to dictionary object UploadControl.Add "Value" , Value 'Add dictionary object to main dictionary UploadRequest.Add name, UploadControl 'Loop to next object BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary) Loop End Sub 'String to byte string conversion Function getByteString(StringStr) For i = 1 to Len(StringStr) char = Mid(StringStr,i,1) getByteString = getByteString & chrB(AscB(char)) Next End Function 'Byte string to string conversion Function getString(StringBin) getString ="" For intCount = 1 to LenB(StringBin) getString = getString & chr(AscB(MidB(StringBin,intCount,1))) Next End Function %>
test.mdb(dsn 名称:upload)
----------------------------------------
表pic: id:自动加 filename:文本 type:文本 what:ole
-----------------------------------------
存成单个文件,放在一个目录下,打开(必须用http://...)getfile.htm 上传一个.gif或.jpg就可以显示了。 对于大文件在显示程序(showpic.asp)中可能会用到循环和getchunk方法