act.slt.asp

PDA,若你死昂师傅你说的附件是打开附件上课的附件四度空间就大方快速减肥

<%
	Class Watermark
		Private WatermarkSetting,rs
		Private Sub Class_Initialize()
			Set Rs = Actcms.ACTEXE("Select ActCMS_WatermarkSetting from Config_Act")
			WatermarkSetting=Split(Rs(0),"^@*&*@^")
			rs.close
		End Sub
        Private Sub Class_Terminate()
		End Sub
		'为图片添加水印
		Function AddWaterMark(FileName)
			Dim objFileSystem, strFileExtName, objImage
			If InStr(FileName, ":") = 0 Then                                            
				FileName = Server.MapPath(FileName)
			End If
			If FileName <> "" And Not IsNull(FileName) Then                           
				strFileExtName = ""
				If InStr(FileName, ".") <> 0 Then
					strFileExtName = LCase(Trim(Mid(FileName, InStrRev(FileName, ".") + 1)))
				End If
				If strFileExtName <> "jpg" And strFileExtName <> "gif" And strFileExtName <> "bmp" And strFileExtName <> "png" Then 
					Exit Function
				End If
				Set objFileSystem = Server.CreateObject("scripting.filesystemobject")
				If objFileSystem.FileExists(FileName) Then             
					If WatermarkSetting(5) <> "0" Then                   
						Select Case WatermarkSetting(5)
							Case "1"                                                           
								If ActCMS.IsObjInstalled("Persits.Jpeg") Then                    
									If ActCMS.IsExpired("Persits.Jpeg") Then
										Response.Write ("对不起，Persits.Jpeg组件已过期!")
										Response.End
									End If
									If WatermarkSetting(6) = "1" Then             
										AddWordMark 1, WatermarkSetting(8), WatermarkSetting(10), WatermarkSetting(11), WatermarkSetting(12), WatermarkSetting(9), WatermarkSetting(7), FileName
									Else                                               
										AddPhotoMark 1, WatermarkSetting(16), WatermarkSetting(17), WatermarkSetting(13), WatermarkSetting(14), WatermarkSetting(15), WatermarkSetting(7), FileName
									End If
								End If
							Case "2"                                                  
								If strFileExtName = "png" Then                        
									Exit Function
								End If
								If ActCMS.IsObjInstalled("wsImage.Resize") Then             
									If ActCMS.IsExpired("wsImage.Resize") Then
										Response.Write ("对不起，sImage.Resize组件已过期!")
										Response.End
									End If
									If WatermarkSetting(6) = "1" Then             
										AddWordMark 2, WatermarkSetting(8), WatermarkSetting(10), WatermarkSetting(11), WatermarkSetting(12), WatermarkSetting(9), WatermarkSetting(7), FileName
									Else                                               
										AddPhotoMark 2, WatermarkSetting(16), WatermarkSetting(17), WatermarkSetting(13), WatermarkSetting(14), WatermarkSetting(15), WatermarkSetting(7), FileName
									End If
								End If
							Case "3"                                                    
								If ActCMS.IsObjInstalled("SoftArtisans.ImageGen") Then           
									If ActCMS.IsExpired("SoftArtisans.ImageGen") Then
										Response.Write ("对不起，SoftArtisans.ImageGen组件已过期!")
										Response.End
									End If
									If WatermarkSetting(6) = "1" Then             
										AddWordMark 3, WatermarkSetting(8), WatermarkSetting(10), WatermarkSetting(11), WatermarkSetting(12), WatermarkSetting(9), WatermarkSetting(7), FileName
									Else                                               
										AddPhotoMark 3, WatermarkSetting(16), WatermarkSetting(17), WatermarkSetting(13), WatermarkSetting(14), WatermarkSetting(15), WatermarkSetting(7), FileName
									End If
								End If
						End Select
					End If
				End If
				Set objFileSystem = Nothing
			End If
		End Function
		'为图片添加文字水印
		Function AddWordMark(MarkComponentID, MarkText, MarkFontColor, MarkFontName, MarkFontBond, MarkFontSize, MarkPosition, FileName)
			Dim objImage, x, y, Text, TextWidth, FontColor, FontName, FondBond, FontSize, OriginalWidth, OriginalHeight
			If InStr(FileName, ":") = 0 Then                                                            
				FileName = Server.MapPath(FileName)
			End If
				
			Text = Trim(MarkText)
			If Text = "" Then
				Exit Function
			End If
			FontColor = Replace(MarkFontColor, "#", "&H")
			FontName = MarkFontName
			If MarkFontBond = "1" Then
				FondBond = True
			Else
				FondBond = False
			End If
			   
			FontSize = CInt(MarkFontSize)
			Select Case MarkComponentID
				Case 1
				
					If Not ActCMS.IsObjInstalled("Persits.Jpeg") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("Persits.Jpeg")
					objImage.Open FileName
					objImage.Canvas.Font.Color = FontColor
					objImage.Canvas.Font.Family = FontName
					objImage.Canvas.Font.Bold = FondBond
					objImage.Canvas.Font.size = FontSize
					TextWidth = objImage.Canvas.GetTextExtent(Text)                                    
					If objImage.OriginalWidth < TextWidth Or objImage.OriginalHeight < FontSize Then    
						Exit Function
					End If
					GetPostion CInt(MarkPosition), x, y, objImage.OriginalWidth, objImage.OriginalHeight, TextWidth, FontSize
					With objImage.Canvas
					  .Print x, y, Text
					End With
					objImage.Save FileName
					
				Case 2
					If Not ActCMS.IsObjInstalled("wsImage.Resize") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("wsImage.Resize")
					objImage.LoadSoucePic CStr(FileName)
					objImage.TxtMarkFont = CStr(FontName)
					objImage.TxtMarkBond = FondBond
					objImage.TxtMarkHeight = FontSize
					FontColor = "&H" & Mid(FontColor, 7) & Mid(FontColor, 5, 2) & Mid(FontColor, 3, 2)  
					objImage.AddTxtMark CStr(FileName), CStr(Text), CLng(FontColor), 1, 1
				Case 3
					If Not ActCMS.IsObjInstalled("SoftArtisans.ImageGen") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
					objImage.LoadImage FileName
					objImage.Font.Height = FontSize
					objImage.Font.name = FontName
					FontColor = "&H" & Mid(FontColor, 7) & Mid(FontColor, 5, 2) & Mid(FontColor, 3, 2)  
					objImage.Font.Color = CLng(FontColor)
					objImage.Text = Text
					GetPostion CInt(MarkPosition), x, y, objImage.Width, objImage.Height, objImage.TextWidth, objImage.TextHeight 
					objImage.DrawTextOnImage x, y, objImage.TextWidth, objImage.TextHeight
					objImage.SaveImage 0, objImage.ImageFormat, FileName
			End Select
			Set objImage = Nothing
		End Function

		Function AddPhotoMark(MarkComponentID, MarkWidth, MarkHeight, MarkPicture, MarkOpacity, MarkTranspColor, MarkPosition, FileName)
			Dim objImage, objMark, x, y, OriginalWidth, OriginalHeight, Position
			If InStr(FileName, ":") = 0 Then                                                            
				FileName = Server.MapPath(FileName)
			End If
			If IsNull(MarkWidth) Or MarkWidth = "" Then
				MarkWidth = 0
			Else
				MarkWidth = CInt(MarkWidth)
			End If
			If IsNull(MarkHeight) Or MarkHeight = "" Then
				MarkHeight = 0
			Else
				MarkHeight = CInt(MarkHeight)
			End If
			If Trim(MarkPicture) = "" Or IsNull(MarkPicture) Then
				Exit Function
			End If
			If IsNull(MarkOpacity) Or MarkOpacity = "" Then
				MarkOpacity = 1
			Else
				MarkOpacity = CSng(MarkOpacity)
			End If
			If MarkTranspColor <> "" Then                                                              
				MarkTranspColor = Replace(MarkTranspColor, "#", "&H")
			Else
			End If
			Select Case MarkComponentID
				Case 1
					If Not ActCMS.IsObjInstalled("Persits.Jpeg") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("Persits.Jpeg")
					Set objMark = Server.CreateObject("Persits.Jpeg")
					objImage.Open FileName
					If objImage.OriginalWidth < MarkWidth Or objImage.OriginalHeight < MarkHeight Then 
						Exit Function
					End If
					objMark.Open Server.MapPath(MarkPicture)
					GetPostion CInt(MarkPosition), x, y, objImage.OriginalWidth, objImage.OriginalHeight, MarkWidth, MarkHeight 
					If MarkTranspColor <> "" Then
						objImage.DrawImage x, y, objMark, MarkOpacity, MarkTranspColor
					Else
						objImage.DrawImage x, y, objMark, MarkOpacity
					End If
					objImage.Save FileName
				Case 2
					If Not ActCMS.IsObjInstalled("wsImage.Resize") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("wsImage.Resize")
					objImage.LoadSoucePic CStr(FileName)
					objImage.LoadImgMarkPic Server.MapPath(MarkPicture)
					objImage.GetSourceInfo OriginalWidth, OriginalHeight
					GetPostion CInt(MarkPosition), x, y, OriginalWidth, OriginalHeight, MarkWidth, MarkHeight
					If MarkTranspColor = "" Then
						MarkTranspColor = 0
					Else
						MarkTranspColor = "&H" & Mid(MarkTranspColor, 7) & Mid(MarkTranspColor, 5, 2) & Mid(MarkTranspColor, 3, 2)
					End If
					objImage.AddImgMark CStr(FileName), Int(x), Int(y), CLng(MarkTranspColor), Int(CSng(MarkOpacity) * 100)
				Case 3
					If Not ActCMS.IsObjInstalled("SoftArtisans.ImageGen") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("SoftArtisans.ImageGen")