这是免费代码,从《化境无组件上传图片2.0》修改而来,目的只为对这问题有困扰的朋友有所帮助, 并对《化境无组件上传图片2.0》的作者说声:谢谢!本代码在iis5+access2000+asp测试通过 ——gztiger --> <html> <head> <title>化境编程界无组件上传文字与图片至数据库之gztiger解决方案 修改者:gztiger </title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> </head> <body bgcolor="#FFFFFF" text="#000000"> <form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data" > <table border="1" cellspacing="0" cellpadding="0" bordercolorlight="#000000" bordercolordark="#CCCCCC" width="91" height="23"> <tr> <td align="left" valign="middle" height="18" width="18"> </td> <td bgcolor="#CCCCCC" align="left" valign="middle" height="18" width="67"> 文件上传</td> </tr> </table> <table width="71%" border="1" cellspacing="0" cellpadding="5" align="center" bordercolordark="#CCCCCC" bordercolorlight="#000000"> <tr bgcolor="#CCCCCC"> <td height="22" align="left" valign="middle" bgcolor="#CCCCCC"> 化境编程界文件上传修改版 修改者:<a href="mailto:gztiger@21cn.com">gztiger</a> </td> </tr> <tr align="left" valign="middle" bgcolor="#eeeeee"> <td bgcolor="#eeeeee" height="92"> <!--此处可任意添加多个文本与文件框 在upfile.asp中对应添加TextN=Trim(upload.form("TextN")) 、Rs("imagedataN")=Image_Set(N) 回显提交信息就不用说了 ,数据库表中亦要添加相对字段名:) --> 文本框1:<input type="text" name="Text1" value="图片与文本上传测试1" ><br> 文本框2:<input type="text" name="Text2" value="图片与文本上传测试2" ><br> 文本框3:<input type="text" name="Text3" value="图片与文本上传测试3" ><br> 图象1 :<input type="file" name="Image1" style="width:400" value=""><br> 图象2 :<input type="file" name="Image2" style="width:400" value=""><br> 图象3 :<input type="file" name="Image3" style="width:400" value=""><br> 文本框4:<input type="text" name="Text4" value="图片与文本上传测试4" ><br> 文本框5:<input type="text" name="Text5" value="图片与文本上传测试5" ><br> 文本框6:<input type="text" name="Text6" value="图片与文本上传测试6" ><br> 文本框7:<input type="text" name="Text7" value="图片与文本上传测试7" > </td> </tr> <tr align="center" valign="middle" bgcolor="#eeeeee"> <td bgcolor="#eeeeee" height="24"> <input type="submit" name="Submit" value="提 交" class="bt"> <input type="reset" name="Submit2" value="清 空" class="bt"> </td> </tr> </table> </form> </body> </html>
upfile.asp -----------------------------------------------------------------------------------------
<%Server.ScriptTimeOut=5000%> <!--#include FILE="upload_5xsoft.inc"--> <title>化境编程界文件上传修改版 修改者:gztiger </title> <% dim upload,file,formName,formPath,iCount set upload=new upload_5xsoft ''建立上传对象
Text1=Trim(upload.form("Text1")) '----获取表单文本框信息(原来代码用for循环)-目的为了说明获取文本框信息的方法 Text2=Trim(upload.form("Text2")) Text3=Trim(upload.form("Text3")) Text4=Trim(upload.form("Text4")) Text5=Trim(upload.form("Text5")) Text6=Trim(upload.form("Text6")) Text7=Trim(upload.form("Text7"))
iCount=0 n=1
response.write "<br>" for each formName in upload.objFile ''------------------列出所有上传了的文件 set file=upload.file(formName) ''--------------------生成一个文件对象 Image_countn=Image_countn&","&file.FileName '----------把图象名做成数组 if file.FileSize>0 then ''------------------------如果 FileSize > 0 说明有文件数据 file.SaveAs Server.mappath("img/"&file.FileName) ''----------保存文件 end if n=n+1 set file=nothing next set upload=nothing '-------------------------------'删除此对象 Image_Set=split(Image_countn,",")'---------------------返回数组
'------添加信息到数据库------------------------------------- Connstr="DBQ="+server.mappath("database\img_text.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};" Set Conn=Server.createobject("ADODB.Connection") Conn.Open Connstr Set Rs=Server.CreateObject("ADODB.RecordSet") sqlstr="select * from imgdata" Rs.Open Sqlstr,Conn,1,3 if not rs.eof then id=Rs("id")+1 else id=1 end if Rs.Addnew Rs("Text1")=Text1 Rs("Text2")=Text2 Rs("Text3")=Text3 Rs("Text4")=Text4 Rs("Text5")=Text5 Rs("Text6")=Text6 Rs("Text7")=Text7 Rs("imagedata1")=Image_Set(1) Rs("imagedata2")=Image_Set(2) Rs("imagedata3")=Image_Set(3) Rs.Update Rs.Close Set Rs=Nothing upload_ok=true
if upload_ok=true then '-------回显提交信息--------------------------- response.Write("您上传的信息如下:"&"<br>") Connstr="DBQ="+server.mappath("database\img_text.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};" Set Conn=Server.createobject("ADODB.Connection") Conn.Open Connstr Set Rs=Server.CreateObject("ADODB.RecordSet") sqlstr="select * from imgdata order by id desc" Rs.Open Sqlstr,Conn,1,1 %> 文本1:<%=Rs("Text1")%><br> 文本2:<%=Rs("Text2")%><br> 文本3:<%=Rs("Text3")%><br> 文本4:<%=Rs("Text4")%><br> 文本5:<%=Rs("Text5")%><br> 文本6:<%=Rs("Text6")%><br> 文本7:<%=Rs("Text7")%><br> <%if Rs("imagedata1")<>"" then%> 图象1:<%=Rs("imagedata1")%><br> <img src="img/<%=Rs("imagedata1")%>"><br> <%end if%> <%if Rs("imagedata2")<>"" then%> 图象2:<%=Rs("imagedata2")%><br> <img src="img/<%=Rs("imagedata2")%>" ><br> <%end if%> <%if Rs("imagedata3")<>"" then%> 图象3:<%=Rs("imagedata3")%><br> <img src="img/<%=Rs("imagedata3")%>" ><br> <% end if Rs.Close Set Rs=Nothing end if %>
upload_5xsoft.inc ---------------------------------------------------------------------------------- <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
Public function Form(strForm) strForm=lcase(strForm) if not objForm.exists(strForm) then Form="" else Form=objForm(strForm) end if end function
Public function File(strFile) strFile=lcase(strFile) if not objFile.exists(strFile) then set File=new FileInfo else set File=objFile(strFile) end if end function
Private Sub Class_Initialize dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile dim iFileSize,sFilePath,sFileType,sFormValue,sFileName dim iFindStart,iFindEnd dim iFormStart,iFormEnd,sFormName Version="化境HTTP上传程序 Version 2.0" set objForm=Server.CreateObject("Scripting.Dictionary") set objFile=Server.CreateObject("Scripting.Dictionary") if Request.TotalBytes<1 then Exit Sub set tStream = Server.CreateObject("adodb.stream") set Data_5xsoft = Server.CreateObject("adodb.stream") Data_5xsoft.Type = 1 Data_5xsoft.Mode =3 Data_5xsoft.Open Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes) Data_5xsoft.Position=0 RequestData =Data_5xsoft.Read
iFormStart = 1 iFormEnd = LenB(RequestData) vbCrlf = chrB(13) & chrB(10) sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1) iStart = LenB (sStart) iFormStart=iFormStart+iStart+1 while (iFormStart + 10) < iFormEnd iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3 tStream.Type = 1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iFormStart Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sInfo = tStream.ReadText tStream.Close '取得表单项目名称 iFormStart = InStrB(iInfoEnd,RequestData,sStart) iFindStart = InStr(22,sInfo,"name=""",1)+6 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart)) '如果是文件 if InStr (45,sInfo,"filename=""",1) > 0 then set theFile=new FileInfo '取得文件名 iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileName=getFileName(sFileName) theFile.FilePath=getFilePath(sFileName) '取得文件类型 iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14 iFindEnd = InStr(iFindStart,sInfo,vbCr) theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileStart =iInfoEnd theFile.FileSize = iFormStart -iInfoEnd -3 theFile.FormName=sFormName if not objFile.Exists(sFormName) then objFile.add sFormName,theFile end if else '如果是表单项目 tStream.Type =1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iInfoEnd Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3 tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sFormValue = tStream.ReadText tStream.Close if objForm.Exists(sFormName) then objForm(sFormName)=objForm(sFormName)&", "&sFormValue else objForm.Add sFormName,sFormValue end if end if iFormStart=iFormStart+iStart+1 wend RequestData="" set tStream =nothing End Sub
Private Sub Class_Terminate if Request.TotalBytes>0 then objForm.RemoveAll objFile.RemoveAll set objForm=nothing set objFile=nothing Data_5xsoft.Close set Data_5xsoft =nothing end if 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 End Class
Class FileInfo dim FormName,FileName,FilePath,FileSize,FileType,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" FileType = "" End Sub
Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=true if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open Data_5xsoft.position=FileStart Data_5xsoft.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=false end function End Class </SCRIPT>
------------------------------------------------- 数据库名:img_text 表:imgdata 字段名 类型 id 自动编号 imagedata1 文本 imagedata2 文本 imagedata3 文本 text1 文本 text2 文本 text3 文本 text4 文本 text5 文本 text6 文本 text7 文本 ------------------------------------------------- 还要新建一空的文件夹img存放图片. --------------------------------------------------
以上是全部代码,希望能对大家有所帮助. |