cl_clscollect.asp

正版创力4.1SQL商业版!!!ASP版。

		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 Cl.ChkObjInstalled("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 Cl.ChkObjInstalled("SoftArtisans.ImageGen") Then
					Exit Function
				End If
				Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
				objImage.LoadImage FileName
				Select Case CInt(MarkPosition)
				Case 1
					Position = 3
				Case 2
					Position = 5
				Case 3
					Position = 1
				Case 4
					Position = 6
				Case 5
					Position = 8
				End Select
				If MarkTranspColor <> "" Then
					MarkTranspColor = "&H" & Mid(MarkTranspColor, 7) & Mid(MarkTranspColor, 5, 2) & Mid(MarkTranspColor, 3, 2)
					objImage.AddWaterMark Server.MapPath(MarkPicture), Position, CSng(MarkOpacity), CLng(MarkTranspColor)
				Else
					objImage.AddWaterMark Server.MapPath(MarkPicture), Position, CSng(MarkOpacity)
				End If
				objImage.SaveImage 0, objImage.ImageFormat, FileName
			'Case 3
			'	If Not Cl.ChkObjInstalled("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)
		End Select
		Set objImage = Nothing
		Set objMark = Nothing
	End Function
	Function GetPostion(MarkPosition, x, y, ImageWidth, ImageHeight, MarkWidth, MarkHeight)
		Select Case CInt(MarkPosition)
		Case 1
			x = 1
			y = 1
		Case 2
			x = 1
			y = Int(ImageHeight - MarkHeight - 1)
		Case 3
			x = Int((ImageWidth - MarkWidth) / 2)
			y = Int((ImageHeight - MarkHeight) / 2)
		Case 4
			x = Int(ImageWidth - MarkWidth - 1)
			y = 1
		Case 5
			x = Int(ImageWidth - MarkWidth - 1)
			y = Int(ImageHeight - MarkHeight - 1)
		End Select
	End Function
	'由原图片根据数据里保存的设置生成缩略图
	Function CreateThumbs(FileName,ThumbFileName)
		CreateThumbs = False
		If Cl.Upload_Setting(2) <> "999" And (Not IsNull(Cl.Upload_Setting(2))) Then
			If Cl.Upload_Setting(17) = "0" Then
				CreateThumbs = CreateThumb(FileName, CInt(Cl.Upload_Setting(15)), CInt(Cl.Upload_Setting(16)), 0, ThumbFileName)
			Else
				CreateThumbs = CreateThumb(FileName, 0, 0, CSng("0.2"), ThumbFileName)
			End If
		End If
	End Function
	'由原图片生成指定宽度和高度的缩略图
	Function CreateThumb(FileName, Width, Height, Rate, ThumbFileName)
		Dim objImage, iWidth, iHeight, strFileExtName
		CreateThumb = False
		If IsNull(FileName) Then'如果原图片未指定直接退出
			Exit Function
		ElseIf FileName = "" Then
			Exit Function
		End If
		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
		If IsNull(ThumbFileName) Then								
			Exit Function
		ElseIf ThumbFileName = "" Then
			Exit Function
		End If
		If IsNull(Width) Then										
			Width = 0
		ElseIf Width = "" Then
			Width = 0
		End If
		If IsNull(Rate) Then											
			Rate = 0
		ElseIf Rate = "" Then
			Rate = 0
		End If
		If IsNull(Height) Then										
			Height = 0
		ElseIf Height = "" Then
			Height = 0
		End If
		If InStr(FileName, ":") = 0 Then		
			FileName = Server.MapPath(FileName)
		End If
		If InStr(ThumbFileName, ":") = 0 Then
			ThumbFileName = Server.MapPath(ThumbFileName)
		End If
		Width = CInt(Width)
		Height = CInt(Height)
		Rate = CSng(Rate)
		Select Case CInt(Cl.Upload_Setting(2))
		Case 0
			If Not Cl.ChkObjInstalled("CreatePreviewImage.cGvbox") Then		
				Exit Function
			End If
			Set objImage = Server.CreateObject("CreatePreviewImage.cGvbox")
			objImage.SetImageFile = FileName									
			If Rate = 0 And (Width <> 0 Or Height <> 0) Then
				objImage.SetPreviewImageSize = Width						
			ElseIf Rate <> 0 Then
				objImage.SetPreviewImageSize = objImage.SetPreviewImageSize * Rate				
			End If
			objImage.SetSavePreviewImagePath = ThumbFileName				
			If objImage.DoImageProcess = False Then						
				Exit Function
			End If
		Case 1
			If Not Cl.ChkObjInstalled("Persits.Jpeg") Then
				Exit Function
			End If
			If CGet.IsExpired("Persits.Jpeg") Then
				Response.Write ("对不起，Persits.Jpeg组件已过期！")
				Response.End
			End If
			Set objImage = Server.CreateObject("Persits.Jpeg")
			objImage.Open FileName
			If Rate = 0 And (Width <> 0 Or Height <> 0) Then
				If Width < objImage.OriginalWidth And Height < objImage.OriginalHeight Then
					If Width = 0 And Height <> 0 Then
						objImage.Width = objImage.OriginalWidth / objImage.OriginalHeight * Height
						objImage.Height = Height
					ElseIf Width <> 0 And Height = 0 Then
						objImage.Width = Width
						objImage.Height = objImage.OriginalHeight / objImage.OriginalWidth * Width
					ElseIf Width <> 0 And Height <> 0 Then
						objImage.Width = Width
						objImage.Height = Height
					End If
				End If
			ElseIf Rate <> 0 Then
				objImage.Width = objImage.OriginalWidth * Rate
				objImage.Height = objImage.OriginalHeight * Rate
			End If
			objImage.Save ThumbFileName
		Case 2
			If Not Cl.ChkObjInstalled("SoftArtisans.ImageGen") Then
				Exit Function
			End If
			If CGet.IsExpired("SoftArtisans.ImageGen") Then
				Response.Write ("对不起，SoftArtisans.ImageGen组件已过期！")
				Response.End
			End If
			Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
			objImage.LoadImage FileName
			If Rate = 0 And (Width <> 0 Or Height <> 0) Then
				If Width < objImage.Width And Height < objImage.Height Then
					If Width = 0 And Height <> 0 Then
						objImage.CreateThumb , CLng(Height), 0, True
					ElseIf Width <> 0 And Height = 0 Then
						objImage.CreateThumb CLng(Width), objImage.Height / objImage.Width * Width, 0, False
					ElseIf Width <> 0 And Height <> 0 Then
						objImage.CreateThumb CLng(Width), CLng(Height), 0, False
					End If
				End If
			ElseIf Rate <> 0 Then
				objImage.CreateThumb CLng(objImage.Width * Rate), CLng(objImage.Height * Rate), 0, False
			End If
			objImage.SaveImage 0, objImage.ImageFormat, ThumbFileName
		'Case 3
		'	If Not Cl.ChkObjInstalled("wsImage.Resize") Then  
		'		Exit Function
		'	End If
		'	If CGet.IsExpired("wsImage.Resize") Then
		'		Response.Write ("对不起，wsImage.Resize组件已过期！")
		'		Response.End
		'	End If
		'	If strFileExtName = "png" Then	
		'		Exit Function
		'	End If
		'	Set objImage = Server.CreateObject("wsImage.Resize")
		'	objImage.LoadSoucePic CStr(FileName)
		'	If Rate = 0 And (Width <> 0 Or Height <> 0) Then
		'		objImage.GetSourceInfo iWidth, iHeight
		'		If Width < iWidth And Height < iHeight Then
		'			If Width = 0 And Height <> 0 Then
		'				objImage.OutputSpic CStr(ThumbFileName), 0, Height, 2
		'			ElseIf Width <> 0 And Height = 0 Then
		'				objImage.OutputSpic CStr(ThumbFileName), Width, 0, 1
		'			ElseIf Width <> 0 And Height <> 0 Then
		'				objImage.OutputSpic CStr(ThumbFileName), Width, Height, 0
		'			Else
		'				objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
		'			End If
		'		Else
		'			objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
		'		End If
		'	ElseIf Rate <> 0 Then
		'		objImage.OutputSpic CStr(ThumbFileName), Rate, Rate, 3
		'	Else
		'		objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
		'	End If
		End Select
		CreateThumb = True
	End Function
End Class

'----------------------缓存类--------------------------
Class Cls_cache
	Private Cache           '缓存内容
	Private Cachename       '缓存application名称
	Private Expiretime      '缓存过期时间
	Private Expiretimename  '缓存过期时间application名称
	Private Path            '缓存页url路径
	Private Vaild           'ansir添加
	Private Sub Class_initialize()
		Path=request.servervariables("url")
		Path=left(path,instrrev(path,"/"))
	End Sub

	Private Sub Class_terminate()
	End Sub

	Public Property Get Valid '读取缓存是否有效/属性
		If Isempty(cache) Or (not Isdate(expiretime)) Then
			Vaild=false
		Else
			Valid=true
		End If
	End Property
	
	Public Property Get Value '读取当前缓存内容/属性
		If Isempty(cache) Or (not Isdate(expiretime)) Then
			Value=null
		Elseif Cdate(expiretime)<now Then
			Value=null
		Else
			Value=cache
		End If
	End Property

	Public Property Let Name(str) '设置缓存名称/属性
		Cachename=str&path
		Cache=application(cachename)
		Expiretimename=str&"expire"&path
		Expiretime=application(expiretimename)
	End Property

	Public Property Let Expire(tm) '设置缓存过期时间/属性
		Expiretime=tm
		Application.lock()
		Application(expiretimename)=expiretime
		Application.unlock()
	End Property

	Public Sub Add(varcache,varexpiretime) '对缓存赋值/方法
		If Isempty(varcache) Or Not Isdate(varexpiretime) Then
			Exit Sub
		End If
		Cache=varcache
		Expiretime=varexpiretime
		Application.lock
		Application(cachename)=cache
		Application(expiretimename)=expiretime
		Application.unlock
	End Sub

	Public Sub Clean() '释放缓存/方法
		Application.lock
		Application(cachename)=empty
		Application(expiretimename)=empty
		Application.unlock
		Cache=empty
		Expiretime=empty
	End Sub
 
	Public Function Verify(varcache2) '比较缓存值是否相同/方法——返回是或否
		If Typename(cache)<>typename(varcache2) Then
			Verify=false
		Elseif Typename(cache)="object" Then
			If Cache Is Varcache2 Then
				Verify=true
			Else
				Verify=false
			End If
		Elseif Typename(cache)="variant()" Then
			If Join(cache,"^")=join(varcache2,"^") Then
				Verify=true
			Else
				Verify=false
			End If
		Else
			If Cache=varcache2 Then
				Verify=true
			Else
				Verify=false
			End If
		End If
	End Function
End Class
%>