asp图片批量上传代码

index.asp教程 上传演示
img_class.asp 获取图片的高度和宽度的类
oupload.asp 上传处理
conn.asp 这个就不用我来说了。连接数据库教程的。
upload_class.asp采用艾恩无组件上传类

可以通过oupload.asp进行设置上传文件类型,大小,是否开启生成缩略图,
默认是开启的。。但是要你的空间支持：aspjpeg组件。。现在的空间基本都支持.

<%
dim oaction
oaction = trim(request("oaction"))
select case oaction
 case "myshow"
  call myshow()
 case "mysave"
  call mysave()
 case else
  call myshow()
end select
sub myshow()
%>

 
 
 

   
   
   
   
   
 

 

<%
end sub
sub mysave()
 imageurl = trim(request.form("imglist"))
 if imageurl = "" or isnull(imageurl) then
  gostr "图片不能为空!"
 else
  conn.execute("insert into piclist(piccontent) values('"&imageurl&"')")
  goalert "添加多图上传成功!","index.asp"
 end if
end sub
%>

<%
dim conn,strconn
set conn = server.createobject("adodb.connection")
strconn = "provider=microsoft.jet.oledb.4.0;data source=" & server.mappath("db.mdb")&""
conn.open strconn

function gostr(alertstr)
        response.write " "
        response.end()
end function

function goalert(message,url)
        response.write ""
        response.end()
end function
%>

img_class.asp

<%
class imgwhinfo
    dim aso
    private sub class_initialize
        set aso=server.createobject("adodb.stream")
        aso.mode=3
        aso.type=1
        aso.open
    end sub
    private sub class_terminate
        err.clear
        set aso=nothing
    end sub

    private function bin2str(bin)
        dim i, str
        for i=1 to lenb(bin)
            clow=midb(bin,i,1)
            if ascb(clow)<128 then
                str = str & chr(ascb(clow))
            else
                i=i+1
                if i <= lenb(bin) then str = str & chr(ascw(midb(bin,i,1)&clow))
            end if
        next
        bin2str = str
    end function
     
    private function num2str(num,base,lens)
        dim ret
        ret = ""
        while(num>=base)
            ret = (num mod base) & ret
            num = (num - num mod base)/base
        wend
        num2str = right(string(lens,"0") & num & ret,lens)
    end function
     
    private function str2num(str,base)
        dim ret,i
        ret = 0
        for i=1 to len(str)
            ret = ret *base + cint(mid(str,i,1))
        next
        str2num=ret
    end function
     
    private function binval(bin)
        dim ret,i
        ret = 0
        for i = lenb(bin) to 1 step -1
            ret = ret *256 + ascb(midb(bin,i,1))
        next
        binval=ret
    end function
     
    private function binval2(bin)
        dim ret,i
        ret = 0
        for i = 1 to lenb(bin)
            ret = ret *256 + ascb(midb(bin,i,1))
        next
        binval2=ret
    end function
     
    private function getimagesize(filespec)
        dim bflag
        dim ret(3)
        aso.loadfromfile(filespec)
        bflag=aso.read(3)
        select case hex(binval(bflag))
        case "4e5089":
            aso.read(15)
            ret(0)="png"
            ret(1)=binval2(aso.read(2))
            aso.read(2)
            ret(2)=binval2(aso.read(2))
        case "464947":
            aso.read(3)
            ret(0)="gif"
            ret(1)=binval(aso.read(2))
            ret(2)=binval(aso.read(2))
        case "535746":
            aso.read(5)
            bindata=aso.read(1)
            sconv=num2str(ascb(bindata),2 ,8)
            nbits=str2num(left(sconv,5),2)
            sconv=mid(sconv,6)
            while(len(sconv)                 bindata=aso.read(1)
                sconv=sconv&num2str(ascb(bindata),2 ,8)
            wend
            ret(0)="swf"
            ret(1)=int(abs(str2num(mid(sconv,1*nbits+1,nbits),2)-str2num(mid(sconv,0*nbits+1,nbits),2))/20)
            ret(2)=int(abs(str2num(mid(sconv,3*nbits+1,nbits),2)-str2num(mid(sconv,2*nbits+1,nbits),2))/20)
        case "ffd8ff":
            do 
            do: p1=binval(aso.read(1)): loop while p1=255 and not aso.eos
            if p1>191 and p1<196 then exit do else aso.read(binval2(aso.read(2))-2)
            do:p1=binval(aso.read(1)):loop while p1<255 and not aso.eos
            loop while true
            aso.read(3)
            ret(0)="jpg"
            ret(2)=binval2(aso.read(2))
            ret(1)=binval2(aso.read(2))
        case else:
            if left(bin2str(bflag),2)="bm" then
                aso.read(15)
                ret(0)="bmp"
                ret(1)=binval(aso.read(4))
                ret(2)=binval(aso.read(4))
            else
                    ret(0)=""
            end if
        end select
        ret(3)="" & ret(1) &""" " & ret(2) &""""
        getimagesize=ret
    end function
     
    public function imgw(imgpath)
        dim fso,imgfile,fileext,arr
        set fso = server.createobject("scripting.filesystemobject")
        if (fso.fileexists(imgpath)) then
            set imgfile = fso.getfile(imgpath)
            fileext=fso.getextensionname(imgpath)
            select case fileext
                case "gif","bmp","jpg","png":
                arr=getimagesize(imgfile.path)
                imgw = arr(1)
            end select
            set imgfile=nothing
        else
            imgw = 0
        end if    
        set fso=nothing
    end function
    
    public function imgh(imgpath)
        dim fso,imgfile,fileext,arr
        set fso = server.createobject("scripting.filesystemobject")
        if (fso.fileexists(imgpath)) then
            set imgfile = fso.getfile(imgpath)
            fileext=fso.getextensionname(imgpath)
            select case fileext
                case "gif","bmp","jpg","png":
                arr=getimagesize(imgfile.path)
                imgh = arr(2)
            end select
            set imgfile=nothing
        else
            imgh = 0
        end if    
        set fso=nothing
    end function
end class
%>

<%
dim formname,forminput,ouploadtype,oaction,ofileexe,oofilesize,ofilesize,ispics,picsp
ofileexe = "jpg|gif|swf|png" '设置上传图片类型
sfilesize = 500     '设置上传文件大小,以kb为单位
ofilesize = 1024*sfilesize
response.buffer = true
response.expiresabsolute = now()-1
response.expires = 0
response.cachecontrol = "no-cache"
response.charset = "gb2312"
formname = trim(request("formname"))
forminput = trim(request("forminput"))
ouploadtype = trim(request("ouploadtype"))
oaction = trim(request("oaction"))
select case oaction
 case "uploadshow"
  call uploadshow()
 case "oupload"
  call oupload()
 case else
  call uploadshow()
end select
sub uploadshow()
%>

 
 
   
文件上传大小：<%=bytestostring(ofilesize)%> 文件上传类型：<%=ofileexe%>

<%
end sub
sub oupload()
 dim upload,path,tempcls,fname,uploadfile
 '===============================================================================
 set upload = new anupload   '创建类实例
 upload.singlesize = ofilesize  '设置单个文件最大上传限制,按字节计；默认为不限制
 upload.maxsize = 1024*1024*1024  '设置最大上传限制,按字节计；默认为不限制
 upload.exe = ofileexe    '设置合法扩展名,以|分割,忽略大小写
 upload.charset = "gb2312"   '设置文本编码，默认为gb2312
 upload.openprocesser = false  '禁止进度条功能，如果启用，需配合客户端程序
 upload.getdata()     '获取并保存数据,必须调用本方法
 '===============================================================================
 if upload.errorid>0 then    '判断错误号,如果myupload.err<=0表示正常
  response.write upload.description '如果出现错误,获取错误描述
 else
  if upload.files(-1).count > 0 then '这里判断你是否选择了文件
   ouploadtype = upload.forms("ouploadtype")
   select case ouploadtype
    case "ad"
     uploadfile = "uploadfile/ad/"
    case "pic"
     uploadfile = "uploadfile/pic/"
    case else
     uploadfile = "uploadfile/ad/"
   end select
   path = server.mappath(uploadfile)   '文件保存路径
   set tempcls = upload.files("myupload")
   tempcls.savetofile path,0
   fname = tempcls.filename
   set tempcls = nothing
   uploadfilename = uploadfile&fname
   ispics = 1   '是否开启生成缩略图
   if ispics = 1 and isobjinstalled("persits.jpeg") then
    set oimage = new imgwhinfo
    ow = oimage.imgw(server.mappath(uploadfilename))
    oh = oimage.imgh(server.mappath(uploadfilename))
    if (ow > 1000 or oh > 950) then
     picsp = 7  '开启缩略图生成的倍率
    end if
    if ((ow > 800 and ow < 1000) or (oh > 750 and oh < 950)) then
     picsp = 5  '开启缩略图生成的倍率
    end if
    if ((ow > 600 and ow < 800) or (oh > 550 and oh < 750)) then
     picsp = 4  '开启缩略图生成的倍率
    end if
    if ((ow > 400 and ow < 600) or (oh > 350 and oh < 550)) then
     picsp = 3  '开启缩略图生成的倍率
    end if
    if ((ow > 200 and ow < 400) or (oh > 150 and oh < 350)) then
     picsp = 2  '开启缩略图生成的倍率
    end if
    s_uploadfilename = uploadfile&"s_"&fname
    os_pic = jpegsmall(uploadfilename,s_uploadfilename,picsp)
    set oimage = nothing
    call uploadopener(os_pic&"|"&uploadfilename,"上传成功!")
   else
    call uploadopener(uploadfilename,"上传成功!")
   end if
  else
   call goupload("您没有上传任何文件!")
  end if
 end if
 set upload = nothing
end sub
sub uploadopener(fvalue,outstr)
 echo("")
end sub

sub goupload(outstr)
 echo("")
end sub

sub echo(str)
 response.write(str) & vbcrlf
end sub

function bytestostring(byval isize)
 dim sret,kb,mb,s
 kb = 1024 : mb = kb * kb
 if not isnumeric(isize) then
  bytestostring = "未知"
  exit function
 end if
 if isize < kb then
  sret = isize & " bytes"
 else
  s = isize / kb
  if s < 10 then
   sret = formatnumber(isize / kb, 2, -1) & " kb"
  elseif s < 100 then
   sret = formatnumber(isize / kb, 1, -1) & " kb"
  elseif s < 1000 then
   sret = formatnumber(isize / kb, 0, -1) & " kb"
  elseif s < 10000 then
   sret = formatnumber(isize / mb, 2, -1) & " mb"
  elseif s < 100000 then
   sret = formatnumber(isize / mb, 1, -1) & " mb"
  elseif s < 1000000 then
   sret = formatnumber(isize / mb, 0, -1) & " mb"
  elseif s < 10000000 then
   sret = formatnumber(isize / mb / kb, 2, -1) & " gb"
  else
   sret = formatnumber(isize / mb / kb, 1, -1) & " gb"
  end if
 end if
 bytestostring = sret
end function

'函数名：isobjinstalled
'作  用：检查组件是否已经安装
'参  数：strclassstring ----组件名
'返回值：true  ----已经安装
'        false ----没有安装
function isobjinstalled(strclassstring)
    on error resume next
    isobjinstalled = false
    err = 0
    dim xtestobj
    set xtestobj = server.createobject(strclassstring)
    if 0 = err then isobjinstalled = true
    set xtestobj = nothing
    err = 0
end function
'缩略图函数
function jpegsmall(originalpic,s_opic,sp)
 dim jpeg,picpath,smallpathpic
 if originalpic = "" or isnull(originalpic) then
  jpegsmall = ""
 else
  if isobjinstalled("persits.jpeg") then
   set jpeg = server.createobject("persits.jpeg")
   opicpath = s_opic
   picpath = server.mappath(originalpic)
   smallpathpic = server.mappath(opicpath)
   jpeg.open picpath
   jpeg.width = jpeg.originalwidth / sp
   jpeg.height = jpeg.originalheight / sp
   jpeg.save smallpathpic
   jpeg.close:set jpeg = nothing
   jpegsmall = s_opic
  else
   jpegsmall = ""
  end if
 end if
end function
%>

upload.class.asp

<%
'=========================================================
 '类名: anupload(艾恩无组件上传类)
 '作者: anlige
 '版本: 艾恩asp无组件上传类优化版(v9.11.1)
 '开发日期: 2008-4-12
 '修改日期: 20010-5-24
 '主页: http://dev.mo.cn
 'email: [email protected]
 'qq: 1034555083
'=========================================================
class anupload
 private form, fils
 private vcharset, vmaxsize, vsinglesize, verr, vversion, vtotalsize, vexe, pid, vop, verrexe,vboundary, vlosttime, vmode, vfilecount
 
 '==============================
 '设置和读取属性开始
 '==============================
 public property let mode(byval value)
  vmode = value
 end property
 
 public property let maxsize(byval value)
  vmaxsize = value
 end property
 
 public property let singlesize(byval value)
  vsinglesize = value
 end property
 
 public property let exe(byval value)
  vexe = lcase(value)
 end property
 
 public property let charset(byval value)
  vcharset = value
 end property
 
 public property get errorid()
  errorid = verr
 end property
 
 public property get filecount()
  filecount = fils.count
 end property
 
 public property get description()
  description = geterr(verr)
 end property
 
 public property get version()
  version = vversion
 end property
 
 public property get totalsize()
  totalsize = vtotalsize
 end property
 
 public property get processid()
  processid = pid
 end property
 
 public property let openprocesser(byval value)
  vop = value
 end property
 
 public property get losttime()
  losttime = vlosttime
 end property
 '==============================
 '设置和读取属性结束，初始化类
 '==============================
 
 private sub class_initialize()
  set form = server.createobject("scripting.dictionary")
  set fils = server.createobject("scripting.dictionary")
  vversion = "艾恩asp无组件上传类优化版(v9.11.1)"
  vmaxsize = -1
  vsinglesize = -1
  verr = -1
  vexe = ""
  vtotalsize = 0
  vcharset = "gb2312"
  vop=false
  pid="anupload"
  setapp "",0,0,""
  vmode = 0
 end sub
 
 private sub class_terminate()
  dim f
  form.removeall()
  for each f in fils
   fils(f).value=empty
   set fils(f) = nothing
  next
  fils.removeall()
  set form = nothing
  set fils = nothing
 end sub
 
 '==============================
 '函数名:getdata
 '作用:处理客户端提交来的所有数据
 '==============================
 public sub getdata()
  dim time1
  time1 = timer()
  if vop then pid=request.querystring("processid")
  dim value, str, bcrlf, fpos, ssplit, slen, istart,ef
  dim totalbytes,tempdata,bytesread,chunkreadsize,partsize,datapart,formend, formhead, startpos, endpos, formname, filename, fileexe, valueend, newname,localname,type_1,contenttype
  totalbytes = request.totalbytes
  ef = false
  if checkentrytype = false then ef = true : verr = 2
  '下面3句注释掉了，因为在iis5.0中，如果上传大小大于限制大小的文件，会出错，一直没找到解决方法。如果是在iis5以上的版本使用，可以取消下面3句的注释
  'if not ef then
   'if vmaxsize > 0 and totalbytes > vmaxsize then ef = true : verr = 1
  'end if
  if ef then exit sub
  if vmode = 0 then
   vtotalsize = 0
   dim streamt
   set streamt = server.createobject("adodb.stream")
   streamt.type = 1
   streamt.mode = 3
   streamt.open
   bytesread = 0
   chunkreadsize = 1024 * 16
   do while bytesread < totalbytes
    partsize = chunkreadsize
    if partsize + bytesread > totalbytes then partsize = totalbytes - bytesread
    datapart = request.binaryread(partsize)
    streamt.write datapart
    bytesread = bytesread + partsize
    setapp "uploading",totalbytes,bytesread,""
   loop
   setapp "uploaded",totalbytes,bytesread,""
   streamt.position = 0
   tempdata = streamt.read
   streamt.close()
   set streamt = nothing
  else
   tempdata = request.binaryread(totalbytes)
  end if
  bcrlf = chrb(13) & chrb(10)
  fpos = instrb(1, tempdata, bcrlf)
        ssplit = midb(tempdata, 1, fpos - 1)
  slen = lenb(ssplit)
  istart = slen + 2
  do while lenb(tempdata) > 2 + slen
   formend = instrb(istart, tempdata, bcrlf & bcrlf)
   formhead = midb(tempdata, istart, formend - istart)
   str = bytes2str(formhead)
   startpos = instr(str, "name=""") + 6
   endpos = instr(startpos, str, """")
   formname = lcase(mid(str, startpos, endpos - startpos))
   valueend = instrb(formend + 3, tempdata, ssplit)
   if instr(str, "filename=""") > 0 then
    startpos = instr(str, "filename=""") + 10
    endpos = instr(startpos, str, """")
    type_1=instr(endpos,lcase(str),"content-type")
    contenttype=trim(mid(str,type_1+13))
    filename = mid(str, startpos, endpos - startpos)
    if trim(filename) <> "" then
     localname = filename
     filename = replace(filename, "/", "")
     filename = mid(filename, instrrev(filename, "") + 1)
     filename = replace(filename,chr(0),"")
     if instr(filename,".")>0 then
      fileexe = split(filename, ".")(ubound(split(filename, ".")))
     else
      fileexe = ""
     end if
     if vexe <> "" then '判断扩展名
      if checkexe(fileexe) = true then
       verr = 3
       verrexe = fileexe
       tempdata = empty
       exit sub
      end if
     end if
     newname = getname()
     newname = newname & "." & fileexe
     vtotalsize = vtotalsize + valueend - formend - 6
     if vsinglesize > 0 and (valueend - formend - 6) > vsinglesize then '判断上传单个文件大小
      verr = 5
      tempdata = empty
      exit sub
     end if
     if vmaxsize > 0 and vtotalsize > vmaxsize then '判断上传数据总大小
      verr = 1
      tempdata = empty
      exit sub
     end if
     if fils.exists(formname) then
      verr = 4
      tempdata = empty
      exit sub
     else
      dim filecls:set filecls=getnewfileobj()
      filecls.contenttype=contenttype
      filecls.size = (valueend - formend - 5)
      filecls.formname = formname
      filecls.newname = newname
      filecls.filename = filename
      filecls.localname = filename
      filecls.extend=split(newname,".")(ubound(split(newname,".")))
      filecls.value =midb(tempdata,formend + 4,valueend - formend - 5)
      fils.add formname, filecls
      set filecls = nothing
     end if
    end if
   else
    value = midb(tempdata, formend + 4, valueend - formend - 6)
    if form.exists(formname) then
     form(formname) = form(formname) & "," & bytes2str(value)
    else
     form.add formname, bytes2str(value)
    end if
   end if
   istart = 2 + slen
   tempdata = midb(tempdata,valueend+2)
  loop
  verr = 0
  tempdata = empty
  vlosttime = formatnumber((timer-time1)*1000,2)
 end sub
 
 public sub setapp(stp,total,current,desc)
  application.lock()
  application(pid)="{id:""" & pid & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
  application.unlock()
 end sub
 '==============================
 '判断扩展名
 '==============================
 private function checkexe(byval ex)
  dim notin: notin = true
  if vexe="*" then
   notin=false
  elseif instr(1, vexe, "|") > 0 then
   dim tempexe: tempexe = split(vexe, "|")
   dim i: i = 0
   for i = 0 to ubound(tempexe)
    if lcase(ex) = tempexe(i) then
     notin = false
     exit for
    end if
   next
  else
   if vexe = lcase(ex) then
    notin = false
   end if
  end if
  checkexe = notin
 end function
 
 '==============================
 '把数字转换为文件大小显示方式
 '==============================
 public function getsize(byval isize)
  dim sret,kb,mb,s
  kb = 1024 : mb = kb * kb
  if not isnumeric(isize) then
   getsize = "未知"
   exit function
  end if
  if isize < kb then
   sret = isize & " bytes"
  else
   s = isize / kb
   if s < 10 then
    sret = formatnumber(isize / kb, 2, -1) & " kb"
   elseif s < 100 then
    sret = formatnumber(isize / kb, 1, -1) & " kb"
   elseif s < 1000 then
    sret = formatnumber(isize / kb, 0, -1) & " kb"
   elseif s < 10000 then
    sret = formatnumber(isize / mb, 2, -1) & " mb"
   elseif s < 100000 then
    sret = formatnumber(isize / mb, 1, -1) & " mb"
   elseif s < 1000000 then
    sret = formatnumber(isize / mb, 0, -1) & " mb"
   elseif s < 10000000 then
    sret = formatnumber(isize / mb / kb, 2, -1) & " gb"
   else
    sret = formatnumber(isize / mb / kb, 1, -1) & " gb"
   end if
  end if
  getsize = sret
 end function
 
 '==============================
 '二进制数据转换为字符
 '==============================
 private function bytes2str(byval byt)
  if lenb(byt) = 0 then
   bytes2str = ""
   exit function
  end if
  dim mystream, bstr
  set mystream =server.createobject("adodb.stream")
  mystream.type = 2
  mystream.mode = 3
  mystream.open
  mystream.writetext byt
  mystream.position = 0
  mystream.charset = vcharset
  mystream.position = 2
  bstr = mystream.readtext()
  mystream.close
  set mystream = nothing
  bytes2str = bstr
 end function
 '==============================
 '弹出提示信息框
 '==============================
 private function gostr(omsg)
  dim outstr
  outstr = ""
  if omsg = "" or isnull(omsg) then
   gostr = outstr
  else
   outstr = outstr & "" & vbcrlf
  end if
  gostr = outstr
 end function
 '==============================
 '获取错误描述
 '==============================
 private function geterr(byval num)
  select case num
   case 0
    geterr = gostr("数据处理完毕!")
   case 1
    geterr = gostr("上传数据超过" & getsize(vmaxsize) & "限制!可设置maxsize属性来改变限制!")
   case 2
    geterr = gostr("未设置上传表单enctype属性为multipart/form-data或者未设置method属性为post,上传无效!")
   case 3
    geterr = gostr("含有非法扩展名(" & verrexe & ")文件!只能上传扩展名为" & replace(vexe, "|", ",") & "的文件")
   case 4
    geterr = gostr("对不起,程序不允许使用相同name属性的文件域!")
   case 5
    geterr = gostr("单个文件大小超出" & getsize(vsinglesize) & "的上传限制!")
  end select
 end function
 private function rndnumber(maxnum,minnum)
  randomize
  rndnumber = int((maxnum-minnum+1)*rnd+minnum)
  rndnumber = rndnumber
 end function
 '==============================
 '根据日期生成随机文件名
 '==============================
 private function getname()
  dim y, m, d, h, mm, s, r
  randomize
  y = year(now)
  m = month(now): if m < 10 then m = "0" & m
  d = day(now): if d < 10 then d = "0" & d
  h = hour(now): if h < 10 then h = "0" & h
  mm = minute(now): if mm < 10 then mm = "0" & mm
  s = second(now): if s < 10 then s = "0" & s
  r = rndnumber(9999999999,1111111111)
  getname = y & m & d & h & mm & s & r
 end function
 
 '==============================
 '检测上传类型是否为multipart/form-data
 '==============================
 private function checkentrytype()
  dim contenttype, ctarray, barray,requestmethod
  requestmethod=trim(lcase(request.servervariables("request_method")))
  if requestmethod="" or requestmethod<>"post" then
   checkentrytype = false
   exit function
  end if
  contenttype = lcase(request.servervariables("http_content_type"))
  ctarray = split(contenttype, ";")
  if ubound(ctarray)>=0 then
   if trim(ctarray(0)) = "multipart/form-data" then
   checkentrytype = true
   vboundary = split(contenttype,"boundary=")(1)
   else
   checkentrytype = false
   end if
  else
   checkentrytype = false
  end if
 end function
 
 '==============================
 '获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
 '==============================
 public function forms(byval formname)
  if trim(formname) = "-1" then
   set forms = form
  else
   if form.exists(lcase(formname)) then
    forms = form(lcase(formname))
   else
    forms = ""
   end if
  end if
 end function
 
 '==============================
 '获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
 '==============================
 public function files(byval formname)
  if trim(formname) = "-1" then
   set files = fils
  else
   if fils.exists(lcase(formname)) then
    set files = fils(lcase(formname))
   else
    set files = nothing
   end if
  end if
 end function
end class
%>