用AspJpeg元件，為輸出圖檔加上浮水印

Dim User_Agent
Dim strContent, intBytes
Dim strDSNless, strSQL, objDBConn, objRS, strId, strFrom
User_Agent = Request.ServerVariables("HTTP_USER_AGENT")
Response.Buffer=True
strFrom=Request.ServerVariables("REMOTE_ADDR")
strId=request("id")
' 資料庫的資料來源
strDSNless="DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("upload.mdb")
' 建立資料庫連結的物件
Set objDBConn = Server.CreateObject("ADODB.Connection")
objDBConn.Open strDSNless  ' 開啟資料庫連結
' 資料庫查詢的SQL語法
strSQL = "Select * FROM myimages Where [id]="&strId
'執行SQL的資料庫查詢
Set objRS = objDBconn.Execute(strSQL)
  objContentType=right(objRS("filename"), 3)
  Response.Expires = 0
  Response.Buffer = True
  Response.Clear
  Response.ContentType ="image/" &objContentType
  Set Jpeg = Server.CreateObject("Persits.Jpeg")  
  Jpeg.OpenBinary objRS("image_blob").Value
     objRS.Close         ' 關閉記錄集合
     Set objRS = Nothing
     objDBConn.Close     ' 關閉資料庫連結
     Set objDBConn = Nothing

Dim aa
aa=Jpeg.Binary

'===============加文字水印=================
Jpeg.Canvas.Font.Color = &H000000 '水印文字顏色
Jpeg.Canvas.Font.Family = "宋體" '字體
Jpeg.Canvas.Font.Bold = False '是否加粗
Jpeg.Canvas.Font.Size = 12 '字體大小
Jpeg.Canvas.Font.ShadowColor = &Hffffff '陰影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = False
Jpeg.Canvas.Font.Quality = 4 ' '輸出質量
Jpeg.Canvas.PrintText 5,5,"-------------------------------------------------------" '水印位置及文字
Jpeg.Canvas.PrintText 5,20,"你的ＩＰ: "& ReqIP
Jpeg.Canvas.PrintText 5,35,"操作系統: "&ClientInfo(0)
Jpeg.Canvas.PrintText 5,50,"瀏覽器名: "&RegExpFilter("Microsoft ", ClientInfo(1), 0, "")
Jpeg.Canvas.PrintText 5,65,"------------------------------------------------------"
Jpeg.Canvas.PrintText 5,80,"西風網路相冊個性簽名(www.chome.idv.tw)"
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.9 '0.3是透明度
cc=MyJpeg.Binary '將最終結果賦值給cc,這時也可以生成目標圖片了
MyJpeg.SendBinary cc '二進輸出給瀏覽器
set aa=nothing
set bb=nothing
set cc=nothing
Jpeg.close : Set Jpeg = Nothing
MyJpeg.Close : Set MyJpeg = Nothing
Logo.Close : Set Logo = Nothing

' ============================================
' 獲取客戶端配置
' ============================================
Public Function ClientInfo(sType)
   If sType = 0 Then
      If InStr(User_Agent, "Windows 98") Then
         ClientInfo = "Windows 98"
      ElseIf InStr(User_Agent, "Win 9x 4.90") Then
         ClientInfo = "Windows ME"
      ElseIf InStr(User_Agent, "Windows NT 5.0") Then
         ClientInfo = "Windows 2000"
      ElseIf InStr(User_Agent, "Windows NT 5.1") Then
         ClientInfo = "Windows XP"
      ElseIf InStr(User_Agent, "Windows NT 5.2") Then
         ClientInfo = "Windows 2003"
      ElseIf InStr(User_Agent, "Windows NT") Then
         ClientInfo = "Windows NT"
      ElseIf InStr(User_Agent, "unix") or InStr(User_Agent, "Linux")   or InStr(User_Agent, "SunOS")   or InStr(User_Agent, "BSD") Then
         ClientInfo = "Unix & Linux"
      Else
         ClientInfo = "Other"
      End If
   ElseIf sType = 1 Then
      If InStr(User_Agent, "MSIE 7") Then
         ClientInfo = "Microsoft Internet Explorer 7.0"
      ElseIf InStr(User_Agent, "MSIE 6") Then
         ClientInfo = "Microsoft Internet Explorer 6.0"
      ElseIf InStr(User_Agent, "MSIE 5") Then
         ClientInfo = "Microsoft Internet Explorer 5.0"
      ElseIf InStr(User_Agent, "MSIE 4") Then
         ClientInfo = "Microsoft Internet Explorer 4.0"
      ElseIf InStr(User_Agent, "Netscape") Then
         ClientInfo = "Netscape"
      ElseIf InStr(User_Agent, "Opera") Then
         ClientInfo = "Opera"
      Else
         ClientInfo = "Other"
      End If
   End If
End Function

' ============================================
' 按照指定的正則表達式替換字符
' ============================================
Public Function RegExpFilter(Patrn, Str, sType, ReplaceWith)
   Dim RegEx
   Set RegEx = New RegExp
   If sType = 1 Then
      RegEx.Global = True
   Else
      RegEx.Global = False
   End If
   RegEx.Pattern = Patrn
   RegEx.IgnoreCase = True
   RegExpFilter = RegEx.Replace(Str, ReplaceWith)
End Function

Public Function ReqIP()
   ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
   If ReqIP = "" or IsNull(ReqIP) Then ReqIP = Request.ServerVariables("REMOTE_ADDR")
End Function