ASP怎样实现批量上传图片,插入到ACCESS数据库,谁有代码案例,注:无组件 网页 图片 html

ASP怎样实现批量上传图片,插入到ACCESS数据库,谁有代码案例,注:无组件 网页 图片 html,第1张

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><% function GetFilePath(FullPath,str) If FullPath <>"" Then GetFilePath = left(FullPath,InStrRev(FullPath, str)) Else GetFilePath = "" End If End function %><% class clsUp '文件上传类 '------------------------ Dim Form,File Dim AllowExt_ '允许上传类型(白名单) Dim NoAllowExt_ '不允许上传类型(黑名单) Private oUpFileStream '上传的数据流 Private isErr_ '错误的代码,0或true表示无错 Private ErrMessage_ '错误的字符串信息 Private isGetData_ '指示是否已执行过GETDATA过程 '------------------------------------------------------------------ '类的属性 Public Property Get Version Version="上传类声明" End Property Public Property Get isErr '错误的代码,0或true表示无错 isErr=isErr_ End Property Public Property Get ErrMessage '错误的字符串信息 ErrMessage=ErrMessage_ End Property Public Property Get AllowExt '允许上传类型(白名单) AllowExt=AllowExt_ End Property Public Property Let AllowExt(Value) '允许上传类型(白名单) AllowExt_=LCase(Value) End Property Public Property Get NoAllowExt '不允许上传类型(黑名单) NoAllowExt=NoAllowExt_ End Property Public Property Let NoAllowExt(Value) '不允许上传类型(黑名单) NoAllowExt_=LCase(Value) End Property '---------------------------------------------------------------- '类实现代码 '初始化类 Private Sub Class_Initialize isErr_ = 0 NoAllowExt="" '黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用号分开,如果黑名单为空,则判断白名单 NoAllowExt=LCase(NoAllowExt) AllowExt="" '白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用号分开 AllowExt=LCase(AllowExt) isGetData_=false End Sub '类结束 Private Sub Class_Terminate on error Resume Next '清除变量及对像 Form.RemoveAll Set Form = Nothing File.RemoveAll Set File = Nothing oUpFileStream.Close Set oUpFileStream = Nothing End Sub '分析上传的数据 Public Sub GetData (MaxSize) '定义变量 on error Resume Next if isGetData_=false then Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo Dim sFormValue,sFileName Dim iFindStart,iFindEnd Dim iFormStart,iFormEnd,sFormName '代码开始 If Request.TotalBytes <1 Then '如果没有数据上传 isErr_ = 1 ErrMessage_="没有数据上传" Exit Sub End If If MaxSize >0 Then '如果限制大小 If Request.TotalBytes >MaxSize Then isErr_ = 2 '如果上传的数据超出限制大小 ErrMessage_="上传的数据超出限制大小" Exit Sub End If End If Set Form = Server.CreateObject ("Scripting.Dictionary") Form.CompareMode = 1 Set File = Server.CreateObject ("Scripting.Dictionary") File.CompareMode = 1 Set tStream = Server.CreateObject ("ADODB.Stream") Set oUpFileStream = Server.CreateObject ("ADODB.Stream") oUpFileStream.Type = 1 oUpFileStream.Mode = 3 oUpFileStream.Open oUpFileStream.Write Request.BinaryRead (Request.TotalBytes) oUpFileStream.Position = 0 RequestBinDate = oUpFileStream.Read iFormEnd = oUpFileStream.Size bCrLf = ChrB (13) &ChrB (10) '取得每个项目之间的分隔符 sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1) iStart = LenB(sSpace) iFormStart = iStart+2 '分解项目 Do iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf &bCrLf)+3 tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iFormStart oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.CharSet = "gb2312" sInfo = tStream.ReadText '取得表单项目名称 iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1 iFindStart = InStr (22,sInfo,"name=""",1)+6 iFindEnd = InStr (iFindStart,sInfo,"""",1) sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) '如果是文件 If InStr (45,sInfo,"filename=""",1) >0 Then Set oFileInfo = new clsFileInfo '取得文件属性 iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10 iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileName = GetFileName(sFileName) oFileInfo.FilePath = GetFilePath(sFileName) oFileInfo.FileExt = GetFileExt(sFileName) iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14 iFindEnd = InStr (iFindStart,sInfo,vbCr) oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileStart = iInfoEnd oFileInfo.FileSize = iFormStart -iInfoEnd -2 oFileInfo.FormName = sFormName file.add sFormName,oFileInfo else '如果是表单项目 tStream.Close tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iInfoEnd oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2 tStream.Position = 0 tStream.Type = 2 tStream.CharSet = "gb2312" sFormValue = tStream.ReadText If Form.Exists (sFormName) Then Form (sFormName) = Form (sFormName) &", " &sFormValue else Form.Add sFormName,sFormValue End If End If tStream.Close iFormStart = iFormStart+iStart+2 '如果到文件尾了就退出 Loop Until (iFormStart+2) >= iFormEnd RequestBinDate = "" Set tStream = Nothing isGetData_=true end if End Sub '保存到文件,自动覆盖已存在的同名文件 Public Function SaveToFile(Item,Path) SaveToFile=SaveToFileEx(Item,Path,True) End Function '保存到文件,自动设置文件名 Public Function AutoSave(Item,Path) AutoSave=SaveToFileEx(Item,Path,false) End Function '保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存 Private Function SaveToFileEx(Item,Path,Over) On Error Resume Next Dim oFileStream Dim tmpPath Dim nohack '防黑缓冲 isErr=0 Set oFileStream = CreateObject ("ADODB.Stream") oFileStream.Type = 1 oFileStream.Mode = 3 oFileStream.Open oUpFileStream.Position = File(Item).FileStart oUpFileStream.CopyTo oFileStream,File(Item).FileSize nohack=split(path,".") '重要修改,防止黑客二进制"01"断名!!! tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改,防止黑客二进制"01"断名!!! if Over then if isAllowExt(GetFileExt(tmpPath)) then oFileStream.SaveToFile tmpPath,2 Else isErr_=3 ErrMessage_="该后缀名的文件不允许上传!" End if Else Path=GetFilePath(Path) if isAllowExt(File(Item).FileExt) then do Err.Clear() nohack=split(Path&GetNewFileName()&"."&File(Item).FileExt,".") '重要修改,防止黑客二进制"01"断名!!! tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改,防止黑客二进制"01"断名!!! oFileStream.SaveToFile tmpPath loop Until Err.number<1 oFileStream.SaveToFile Path Else isErr_=3 ErrMessage_="该后缀名的文件不允许上传!" End if End if oFileStream.Close Set oFileStream = Nothing if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath) End Function '取得文件数据 Public Function FileData(Item) isErr_=0 if isAllowExt(File(Item).FileExt) then oUpFileStream.Position = File(Item).FileStart FileData = oUpFileStream.Read (File(Item).FileSize) Else isErr_=3 ErrMessage_="该后缀名的文件不允许上传!" FileData="" End if End Function '取得文件路径 Public function GetFilePath(FullPath) If FullPath <>"" Then GetFilePath = Left(FullPath,InStrRev(FullPath, "\")) Else GetFilePath = "" End If End function '取得文件名 Public Function GetFileName(FullPath) If FullPath <>"" Then GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) Else GetFileName = "" End If End function '取得文件的后缀名 Public Function GetFileExt(FullPath) If FullPath <>"" Then GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1)) Else GetFileExt = "" End If End function '取得一个不重复的序号 Public Function GetNewFileName() dim ranNum dim dtNow dtNow=Now() ranNum=int(90000*rnd)+10000 GetNewFileName=year(dtNow) &right("0" &month(dtNow),2) &right("0" &day(dtNow),2) &right("0" &hour(dtNow),2) &right("0" &minute(dtNow),2) &right("0" &second(dtNow),2) &ranNum End Function Public Function isAllowExt(Ext) if NoAllowExt="" then isAllowExt=cbool(InStr(1,""&AllowExt&"",LCase(""&Ext&""))) else isAllowExt=not CBool(InStr(1,""&NoAllowExt&"",LCase(""&Ext&""))) end if End Function End Class PS:下面还有一部分代码!最后需要整合一起!

建议将图片保存在磁盘里,增加一张表保存记录每个产品编号对应的图片保存位置,通过图片位置查找图片。这样就可以大量保存图片,数据库又不至于过度膨胀。

建议数据结构如下

商品表(商品ID 主键,商品名称)

图片表(ID 自动编号 主键,商品ID ,图片位置 text(255))

商品表与图片表基于“商品ID”建立一对多参照完整性关系。

我们通过image控件和图片地址显示图片,这样每个商品编码下就可以插入无限个图片了。

如果你不会做动态的图片更新插入的话

就用dreamweaver自带的相册制作工具

在命令菜单里有个创建相册命令

你执行一下

就可以自动生成网页相册(图片不限数量)——不过要预装firework

另外你也可以直接用photoshop的创建网页相册功能

讲你的大批量图片一次生成网页浏览模式的网页!!!!

还有问题可以到我空间留言

http://hi.baidu.com/dell910


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/sjk/9984441.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-04
下一篇 2023-05-04

发表评论

登录后才能评论

评论列表(0条)

保存