ks_thumbs.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394 
'程序版权： 科汛网络
'E-Mail  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'====================================================================================================================
'-----------------------------------------------------------------------------------------------
'科汛网站管理系统,通用添加水印及生成缩略图类
'开发:林文仲 版本 V 2.2
'-----------------------------------------------------------------------------------------------
Class Thumb
		Private KSCMS
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConn()
		 Set KSCMS=Nothing
		End Sub
		'为图片添加水印
		Function AddWaterMark(FileName)
			Dim strMarkSettingSql, MarkSettingRs, 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(KSCMS.GetConfig("FsoObjName"))
				If objFileSystem.FileExists(FileName) Then             
					strMarkSettingSql = "select * from KS_Thumb"
					Set MarkSettingRs = Conn.Execute(strMarkSettingSql)
					If MarkSettingRs("MarkComponent") <> "0" Then                   
						Select Case MarkSettingRs("MarkComponent")
							Case "1"                                                           
								If KSCMS.IsObjInstalled("Persits.Jpeg") Then                    
									If KSCMS.IsExpired("Persits.Jpeg") Then
										Response.Write ("对不起，Persits.Jpeg组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 1, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 1, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
							Case "2"                                                  
								If strFileExtName = "png" Then                        
									Exit Function
								End If
								If KSCMS.IsObjInstalled("wsImage.Resize") Then             
									If KSCMS.IsExpired("wsImage.Resize") Then
										Response.Write ("对不起，sImage.Resize组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 2, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 2, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
							Case "3"                                                    
								If KSCMS.IsObjInstalled("SoftArtisans.ImageGen") Then           
									If KSCMS.IsExpired("SoftArtisans.ImageGen") Then
										Response.Write ("对不起，SoftArtisans.ImageGen组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 3, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 3, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
						End Select
					End If
					Set MarkSettingRs = Nothing
				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 KSCMS.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 KSCMS.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 KSCMS.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 KSCMS.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 KSCMS.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