ASP wsImage组件添加水印的实用代码

摘要：ASP给图片加水印是需要组件的...常用的有aspjpeg软件和中国人自己开发的wsImage软件，可以上网搜索下载这两个软件，推荐使用咱们...

ASP给图片加水印是需要组件的...常用的有aspjpeg软件和中国人自己开发的wsImage软件，可以上网搜索下载这两个软件，推荐使用咱们中国人自己开发的wsImage，毕竟是中文版，容易操作．

注册组件的方法:

命令提示符下输入"regsvr32 [Dll路径]" 就可以了．

图片添加水印无非就是获得图片大小,然后把水印写上去..ASP代码只是起个控制组件的作用.用代码来说明一切吧.

一:获得图片大小(这里是用象素值表示的.学PhotoShop的朋友都应该明白)

复制代码代码如下:

set obj=server.CreateObject("wsImage.Resize") ''调用组件

obj.LoadSoucePic server.mappath("25.jpg") ''打开图片,图片名字是25.jpg

obj.GetSourceInfo iWidth,iHeight

response.write "图片宽度:" & iWidth & "<br>" ''获得图片宽度

response.write "图片高度:" & iHeight & "<br>" ''获得图片高度

strError=obj.errorinfo

if strError<>"" then

response.write obj.errorinfo

end if

obj.free

set obj=nothing

''----------------------------------------------------------------''

二:添加文字水印

复制代码代码如下:

set obj=server.CreateObject("wsImage.Resize")

obj.LoadSoucePic server.mappath("25.jpg") ''装载图片

obj.Quality=75

obj.TxtMarkFont = "华文彩云" ''设置水印文字字体

obj.TxtMarkBond = false ''设置水印文字的粗细

obj.MarkRotate = 0 ''水印文字的旋转角度

obj.TxtMarkHeight = 25 ''水印文字的高度

obj.AddTxtMark server.mappath("txtMark.jpg"), "带你离境", &H00FF00&, 10, 70

strError=obj.errorinfo ''生成图片名字,文字颜色即水印在图片的位置

if strError<>"" then

response.write obj.errorinfo

end if

obj.free

set obj=nothing

''----------------------------------------------------------------''

三:添加图片水印

复制代码代码如下:

set obj=server.CreateObject("wsImage.Resize")

obj.LoadSoucePic server.mappath("25.jpg") ''装载图片

obj.LoadImgMarkPic server.mappath("blend.bmp") ''装载水印图片

obj.Quality=75

obj.AddImgMark server.mappath("imgMark.jpg"), 315, 220,&hFFFFFF, 70

strError=obj.errorinfo ''生成图片名字,文字颜色即水印在图片的位置

if strError<>"" then

response.write obj.errorinfo

end if

obj.free

set obj=nothing

''----------------------------------------------------------------''

其实给图片添加水印就这么简单.然后我在说下WsImage.dll组件的另外两个主要用法.包括:

剪裁图片,生成图片的缩略图.

还是以我得习惯,用代码加注释说明:

剪裁图片:

复制代码代码如下:

set obj=server.CreateObject("wsImage.Resize")

obj.LoadSoucePic server.mappath("25.jpg")

obj.Quality=75

obj.cropImage server.mappath("25_crop.jpg"),100,10,200,200 ''定义裁减大小和生成图片名字

strError=obj.errorinfo

if strError<>"" then

response.write obj.errorinfo

end if

obj.free

set obj=nothing

详细注释:裁减图片用到了WsImage的CropImage方法.其中定义生成图片时候,100,10是左上角的裁减点,即离图片左边是100象素,顶端10象素.后两个200代表的是裁减的宽带和高和高度.

''----------------------------------------------------------------''

生成图片缩略图:

复制代码代码如下:

set obj=server.CreateObject("wsImage.Resize")

obj.LoadSoucePic server.mappath("25.jpg") ''加载图片

obj.Quality=75

obj.OutputSpic server.mappath("25_s.jpg"),0.5,0.5,3 ''定义缩略图的名字即大小

strError=obj.errorinfo

if strError<>"" then

response.write obj.errorinfo

end if

obj.free

set obj=nothing

详细说明:

产生缩略图共有四种导出方式：

(1) obj.OutputSpic server.mappath("25_s.jpg"),200,150,0

200为输出宽，150为输出高，这种输出形式为强制输出宽高，可能引起图片变形。

(2) obj.OutputSpic server.mappath("25_s.jpg"),200,0,1

以200为输出宽，输出高将随比列缩放。

(3) obj.OutputSpic server.mappath("25_s.jpg"),0,200,2

以200为输出高，输出宽将随比列缩放。

(4) obj.OutputSpic server.mappath("25_s.jpg"),0.5,0.5,3

第一个0.5表示生成的缩略图是原图宽的一半，即表示宽缩小比例。

第二个0.5表示生成的缩略图是原图高的一半，即表示高缩小比例。

宽高的缩小比例一致意味着将对原图进行比例缩小。宽高的缩放比例如果大于1，则对原图进行放大。

2---------------------------------------------------------------------------------------

复制代码代码如下:

Dim stream1,stream2,istart,iend,filename

istart=1

vbEnter=Chr(13)&Chr(10)

function getvalue(fstr,foro,paths)'fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径

if foro then

getvalue=""

istart=instring(istart,fstr)

istart=istart+len(fstr)+5

iend=instring(istart,vbenter+"-----------------------------")

if istart>5+len(fstr) then

getvalue=substring(istart,iend-istart)

else

getvalue=""

end if

else

istart=instring(istart,fstr)

istart=istart+len(fstr)+13

iend=instring(istart,vbenter)-1

filename=substring(istart,iend-istart)

filename9=right(getfilename(filename),4)'取原文件后缀

filename8=year(now())&month(now())&day(now())&hour(now())&minute(now())&second(now())&int(9*10^3*rnd)+10^3'取随机文件名,

'如果你要加长文件名,请修改(100*rnd)中100的值

filename=replace(getfilename(filename),getfilename(filename),filename8) '替换原文件名,活用replace函数

filename=filename&filename9 '加上文件后缀,规则为生成的随机文件名加上原文件后缀

istart=instring(iend,vbenter+vbenter)+3

iend=instring(istart,vbenter+"-----------------------------")

filestart=istart

filesize=iend-istart-1

objstream.position=filestart

Set sf = Server.CreateObject("ADODB.Stream")

sf.Mode=3

sf.Type=1

sf.Open

objstream.copyto sf,FileSize

if filename<>"" then

Set rf = Server.CreateObject("Scripting.FileSystemObject")

i=0

fn=filename

while rf.FileExists(server.mappath(paths+fn))

fn=cstr(i)+filename

i=i+1

wend

filename=fn

sf.SaveToFile server.mappath(paths+filename),2

'''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Jpeg

Set Jpeg = Server.CreateObject("Persits.Jpeg")

If -2147221005=Err then

Response.write "没有这个组件，请安装!" '检查是否安装AspJpeg组件

Response.End()

End If

Jpeg.Open (server.mappath(paths+filename)) '打开图片

If err.number then

Response.write"打开图片失败,请检查路径！"

Response.End()

End if

Dim aa

aa=Jpeg.Binary '将原始数据赋给aa

'=========加文字水印=================

Jpeg.Canvas.Font.Color = &Hff0000 '水印文字颜色

Jpeg.Canvas.Font.Family = Arial'字体

Jpeg.Canvas.Font.Bold = True '是否加粗

Jpeg.Canvas.Font.Size = 30'字体大小

Jpeg.Canvas.Font.ShadowColor = &H000000 '阴影色彩

Jpeg.Canvas.Font.ShadowYOffset = 1

Jpeg.Canvas.Font.ShadowXOffset = 1

Jpeg.Canvas.Brush.Solid = True

Jpeg.Canvas.Font.Quality = 4 '输出质量

Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-100,Jpeg.OriginalHeight/2+20,"www.my9933.com" '水印位置及文字

bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度

'============调整文字透明度================

Set MyJpeg = Server.CreateObject("Persits.Jpeg")

MyJpeg.OpenBinary aa

Set Logo = Server.CreateObject("Persits.Jpeg")

Logo.OpenBinary bb

MyJpeg.DrawImage 0,0, Logo, 0.2 '0.3是透明度

cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了

response.BinaryWrite cc '将二进输出给浏览器

MyJpeg.Save (server.mappath(paths+filename))

set aa=nothing

set bb=nothing

set cc=nothing

Jpeg.close

MyJpeg.Close

Logo.Close

'''''''''''''''''''''''''''''''''''''''''''''''''''''

end if

getvalue=filename

end if

end function

Function subString(theStart,theLen)

dim i,c,stemp

objStream.Position=theStart-1

stemp=""

for i=1 to theLen

if objStream.EOS then Exit for

c=ascB(objStream.Read(1))

If c > 127 Then

if objStream.EOS then Exit for

stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))

i=i+1

else

stemp=stemp&Chr(c)

End If

subString=stemp

End function

Function inString(theStart,varStr)

dim i,j,bt,theLen,str

InString=0

Str=toByte(varStr)

theLen=LenB(Str)

for i=theStart to objStream.Size-theLen

if i>objstream.size then exit Function

objstream.Position=i-1

if AscB(objstream.Read(1))=AscB(midB(Str,1)) then

InString=i

for j=2 to theLen

if objstream.EOS then

inString=0

Exit for

end if

if AscB(objstream.Read(1))<>AscB(MidB(Str,j,1)) then

InString=0

Exit For

end if

if InString<>0 then Exit Function

end if

End Function

Private function GetFileName(FullPath)

If FullPath <> "" Then

GetFileName = mid(FullPath,InStrRev(FullPath, "")+1)

Else

GetFileName = ""

End If

End function

function toByte(Str)

dim i,iCode,c,iLow,iHigh

toByte=""

For i=1 To Len(Str)

c=mid(Str,i,1)

iCode =Asc(c)

If iCode<0 Then iCode = iCode + 65535

If iCode>255 Then

iLow = Left(Hex(Asc(c)),2)

iHigh =Right(Hex(Asc(c)),2)

toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)

Else

toByte = toByte & chrB(AscB(c))

End If

End function

3---------------------------------------------------------------------------------------

用asp组件Persits.Jpeg给图片加水印，生成缩略图

复制代码代码如下:

FileName="1.jpg"

Set Jpeg = Server.CreateObject("Persits.Jpeg")

' 获取源图片路径

Path = Server.MapPath(FileName)

' 打开源图片

'response.write(Path)

Jpeg.Open Path

' 设定生成缩略图细节这里有很多种设定方法下面的方法是先判断宽高比然后按比例缩放

If Jpeg.OriginalWidth / Jpeg.OriginalHeight > 1 then

Jpeg.Width = 98

Jpeg.Height = int((98/Jpeg.OriginalWidth)*Jpeg.OriginalHeight)

elseif Jpeg.OriginalWidth / Jpeg.OriginalHeight < 1 then

Jpeg.Width = 98

Jpeg.Height= int((98/Jpeg.OriginalWidth)*Jpeg.Height)

end if

' 设定锐化效果

Jpeg.Sharpen 1, 130

' 向指定路径生成缩略图

Response.Write Server.MapPath(".")

Jpeg.Save Server.MapPath(".")&"small"&filename

'response.write filename1

'response.write Server.MapPath("uploadpic/small")&""&filename1

' 注意这两个Session

'Session("PPP0")=GP_curPath&FileName

'Session("PPP1")=GP_curPath&"small"&FileName

Set Jpeg = Nothing

'自动产生缩掠图结束

'大图片打水印开始

' 建立实例

Set Jpeg = Server.CreateObject("Persits.Jpeg")

' 打开目标图片

Path = Server.MapPath(FileName)

' 打开源图片

Jpeg.Open Path

' 添加文字水印

Jpeg.Canvas.Font.Color = &HFF0000' 红色

Jpeg.Canvas.Font.Family = "宋体"

Jpeg.Canvas.Font.Bold = True

Jpeg.Canvas.Print 10, 10, "宏蓝科技"

' 保存文件

Jpeg.Save Server.MapPath(".")&"smallw_"&filename

' 注销对象

Set Jpeg = Nothing

'大图片打水印结束

4---------------------------------------------------------------------------------------

利用ASPJPEG组建加水印ASP实现代码

复制代码代码如下:

Class qswhImg

dim aso

Private Sub Class_Initialize

set aso=CreateObject("Adodb.Stream")

aso.Mode=3

aso.Type=1

aso.Open

End Sub

Private Sub Class_Terminate

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

Bin2Str = Str

End Function

Private Function Num2Str(num,base,lens)

'qiushuiwuhen (2002-8-12)

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)

'qiushuiwuhen (2002-8-12)

dim ret

ret = 0

for i=1 to len(str)

ret = ret *base + cint(mid(str,i,1))

Str2Num=ret

End Function

Private Function BinVal(bin)

'qiushuiwuhen (2002-8-12)

dim ret

ret = 0

for i = lenb(bin) to 1 step -1

ret = ret *256 + ascb(midb(bin,i,1))

BinVal=ret

End Function

Private Function BinVal2(bin)

'qiushuiwuhen (2002-8-12)

dim ret

ret = 0

for i = 1 to lenb(bin)

ret = ret *256 + ascb(midb(bin,i,1))

BinVal2=ret

End Function

Function getImageSize(filespec)

'qiushuiwuhen (2002-9-3)

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)<nBits*4)

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: 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)="width=""" & ret(1) &""" height=""" & ret(2) &""""

getimagesize=ret

End Function

End Class

SavefullPath="326151745wldn.jpg" '图片路径赋值或图片路径变量赋值

'取得图片的宽度

Set qswh = new qswhImg

arr = qswh.getImageSize(Server.Mappath(SavefullPath))

Set qswh = Nothing

str_ImgWidth=arr(1)

str_ImgHeight=arr(2)

If Int(str_ImgWidth) > 600 Then

str_ImgWidth = 600

Else

str_ImgWidth = str_ImgWidth

End If

'加水印

If Int(str_ImgWidth) > 300 And Int(str_ImgHeight) > 100 Then

LocalFile=Server.MapPath(SavefullPath)

TargetFile=Server.MapPath(SavefullPath)

Dim Jpeg

Set Jpeg = Server.CreateObject("Persits.Jpeg")

If -2147221005=Err then

Response.Write("<script language='javascript'>alert('没有这个组件，请安装!');history.back();</script>") '检查是否安装AspJpeg组件

Response.End()

End If

Jpeg.Open (LocalFile) '打开图片

If err.number then

Response.Write("<script language='javascript'>alert('打开图片失败,请检查路径！');history.back();</script>")

Response.End()

End if

Dim aa

aa=Jpeg.Binary '将原始数据赋给aa

'=========加文字水印=================

Jpeg.Canvas.Font.Color = &Hfffffff '水印文字颜色

Jpeg.Canvas.Font.Family = Arial '字体

Jpeg.Canvas.Font.Bold = True '是否加粗

Jpeg.Canvas.Font.Size = 20 '字体大小

Jpeg.Canvas.Font.ShadowColor = &H000000 '阴影色彩

Jpeg.Canvas.Font.ShadowYOffset = 1

Jpeg.Canvas.Font.ShadowXOffset = 1

Jpeg.Canvas.Brush.Solid = True

Jpeg.Canvas.Font.Quality = 10 ' '输出质量

Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-40,Jpeg.OriginalHeight/2-10,"网站建设" '水印位置及文字

bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度

'============调整文字透明度================

Set MyJpeg = Server.CreateObject("Persits.Jpeg")

MyJpeg.OpenBinary aa

Set Logo = Server.CreateObject("Persits.Jpeg")

Logo.OpenBinary bb

MyJpeg.DrawImage 0,0, Logo, 0.5 '0.3是透明度

cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了

Response.BinaryWrite cc '将二进输出给浏览器

MyJpeg.Save (TargetFile)

set aa = nothing

set bb = nothing

set cc = nothing

Jpeg.Close

MyJpeg.Close

Logo.Close

End If

'加水印