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

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