上传图片加水印功能

说明：空间必须支持：aspjpeg组件。。现在的空间基本都支持.

index.asp文件

<%
action = trim(request("action"))
select case action
 case "list"
  call list()
 case "saveconfig"
  call saveconfig()
 case else
  call list()
end select
sub list()
%>

 
   
 
 
   
 
 
   
   
 
 
   
   
 
 
   
   
 
 
   
   
 
 
   
   
 

只做了简单操作,更改config.asp文件里面的参数
上传图片水印设置
水印组件	checked<%end if%>>       aspjpeg
水印类型	checked<%end if%>>       关闭水印功能       <%if isobjinstalled("persits.jpeg") then%>       checked<%end if%>>       文字水印       checked<%end if%>>       图片水印       <%else%>       注意：你还没有安装水印组件，无法启用水印功能。       <%end if%>
水印位置	checked<%end if%>>       左上       checked<%end if%>>       右上       checked<%end if%>>       左下       checked<%end if%>>       右下       checked<%end if%>>       居中
水印文字	字体             字号             px       颜色       #
水印图片

---

示例如下：

 原图片：

    水印图片：

    上传图片：

<%
end sub
%>

<%
'----------------------------- 详细信息查看：index.asp
dim jpegtype,jpeglocation,jpegtxt,jpegsize,jpegfont,jpegcolor,jpegpic
'---------- 水印类型,0:关闭水印功能,1:文字水印,2:图片水印
jpegtype = 2
'---------- 水印位置,0:左上,1:右上,2:左下,3:右下,4:居中
jpeglocation = 2
'---------- 水印文字,随便输入
jpegtxt = "永恒浪子哥哥"
'---------- 水印文字,字号
jpegsize = 14
'---------- 水印文字,字体
jpegfont = "宋体"
'---------- 水印文字,颜色
jpegcolor = "ffffff"
'---------- 图片水印,图片
jpegpic = "logo.gif"
'==========================================
'函数名：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
%>

upload.asp文件

<%
'=====================================================================
' 软件名称：永恒浪子旅游管理系统
' 当前版本：hulang content management system version 1.0
' 文件名称：upload.asp
' 更新日期：2010-08-09
' 开发作者：永恒浪子 email(邮箱)：hulangfy@163.com qq：383131380
' 官方网站：http://hi.baidu.com/hulangfy
'=====================================================================
' copyright 2010-2010 hulangfy@163.com - all rights reserved.
' hulangfy is a trademark of hulangfy@163.com
'=====================================================================
'------------------------------------------------------
dim formname,forminput,ouploadtype,oaction,ofileexe,oofilesize,ofilesize,ispics,picsp
'------------------------------------------------------
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"))
'------------------------------------------------------
select case ouploadtype
 '------------------------------------------- oaspjpeg
 case "oaspjpeg"
  ofileexe = "jpg|gif|swf|png"
  sfilesize = 540
 '-------------------------------------------
 case else
  ofileexe = "jpg|gif|swf|png"
  sfilesize = 888
end select
ofilesize = 1024*sfilesize
'------------------------------------------------------
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 "oaspjpeg"
     uploadfile = "uploadfile/images/"
    case else
     uploadfile = "uploadfile/others/"
   end select
   path = server.mappath(uploadfile)   '文件保存路径
   set tempcls = upload.files("myupload")
   tempcls.savetofile path,0
   fname = tempcls.filename
   set tempcls = nothing
   uploadfilename = uploadfile&fname
   
   if isobjinstalled("persits.jpeg") then
    s_uploadfilename = uploadfile&"s_"&fname
    os_pic = startjpeg(uploadfilename,s_uploadfilename)
    call s_uploadopener(formname,"s_"&forminput,os_pic)
    call uploadopener(formname,forminput,uploadfilename,"上传成功!")
   else
    call uploadopener(formname,forminput,uploadfilename,"上传成功!")
   end if
  else
   call goupload("您没有上传任何文件!")
  end if
 end if
 set upload = nothing
end sub
'------------------------------------------------------
sub uploadopener(fname,finput,fvalue,outstr)
 echo("")
end sub
'------------------------------------------------------
sub s_uploadopener(fname,finput,fvalue)
 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
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 startjpeg(codepic,iscodepic)
 

 if (codepic = "" or isnull(codepic)) then
  exit function
 end if
 if jpegtype <> 0 then
  
  set bg = server.createobject("persits.jpeg")
  bg.open server.mappath(codepic)
  bg_w = bg.width
  bg_h = bg.height
  
  if jpegtype = 1 then
   bg.canvas.font.color = "&h" & jpegcolor
   bg.canvas.font.shadowcolor = &hffffff
   bg.canvas.font.family = jpegfont
   bg.canvas.font.size = jpegsize
   bg.canvas.font.bold = false
   bg.canvas.font.quality = 3
   select case jpeglocation
    case 0
     x = 20 : y = 20
    case 1
     x = bg_w - len(jpegtxt) * 20 : y = 20
    case 2
     x = 20 : y = bg_h - 20
    case 3
     x = bg_w - len(jpegtxt) * 20 : y = bg_h - 20*2
    case 4
     x = bg_w - len(jpegtxt) * 20 : y = bg_h - 20*2
   end select
   bg.canvas.printtext x, y, jpegtxt
  end if
  
  if jpegtype = 2 then
   set logo = server.createobject("persits.jpeg")
   logo.open server.mappath(jpegpic)
   logo_w = logo.width
   logo_h = logo.height
   select case jpeglocation
    case 0
     x = 20 : y = 20
    case 1
     x = bg_w - logo_w - 20 : y = 20
    case 2
     x = 20 : y = logo_h - 20
    case 3
     x = bg_w - logo_w - 20 : y = bg_h - logo_h - 20
    case 4
     x = bg_w - logo_w : y = bg_h - logo_h - 20
   end select
   bg.drawimage x, y, logo, 0.8, &hffffff
   set logo = nothing
  end if
  
  bg.quality = 85
  
  bg.save server.mappath(iscodepic)
  set bg = nothing
  startjpeg = iscodepic
 end if
 '================aspjpeg 结束====================
end function
%>

<%
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
%>