cls_custom.asp

网络上经典的图片程序

<%
Class LabelCustom_Cls
	Private re,TemplateCode,ChannelID
	
	Private Sub Class_Initialize()
		On Error Resume Next
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		ChannelID = 0
	End Sub

	Private Sub Class_Terminate()
		Set re = Nothing
	End Sub
	Public Property Let Template(ByVal NewValue)
		TemplateCode = NewValue
	End Property
	Public Property Get Template()
		Template = TemplateCode
	End Property
	Public Property Let Channel(ByVal NewValue)
		ChannelID = ChkNumeric(NewValue)
	End Property
	
	Private Function ChkNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			CHECK_ID = CLng(CHECK_ID)
			If CHECK_ID < 0 Then CHECK_ID = 0
		Else
			CHECK_ID = 0
		End If
		ChkNumeric = CHECK_ID
	End Function
	
	Public Sub Execute()
		Dim i,maxlen
		Dim ArrayMarked
		Dim strLabel,strName,strContent
		ArrayMarked = FindMarked(TemplateCode,"{$NewaspLabel_","}",2)
		maxlen = UBound(ArrayMarked)
		If maxlen > 0 Then
			For i = 0 To maxlen
				strName = ArrayMarked(i)
				If strName <> "" And strName <> "No Data" Then
					strLabel = "{$NewaspLabel_" & strName & "}"
					strContent = GetContent(strName)
					TemplateCode = Re_Replace(TemplateCode,strLabel,strContent)
				End If
			Next
		Else
			strName = ArrayMarked(0)
			If strName <> "" And strName <> "No Data" Then
				strLabel = "{$NewaspLabel_" & strName & "}"
				strContent = GetContent(strName)
				TemplateCode = Re_Replace(TemplateCode,strLabel,strContent)
			End If
		End If
	End Sub
	Private Function GetContent(ByVal strName)
		Dim SQL,Rs
		strName = Trim(Replace(strName, "'", ""))
		
		If Len(strName) > 0 Then
			SQL = "SELECT TOP 1 Content FROM NC_CustomLabel WHERE (ChannelID=" & ChannelID & " Or ChannelID=0) And estop=0 And LabelName='" & strName & "' ORDER By ChannelID DESC"
			Set Rs = Newasp.Execute(SQL)
			If Rs.BOF And Rs.EOF Then
				GetContent = ""
			Else
				GetContent = Rs(0)
			End If
			Set Rs = Nothing
		Else
			GetContent = ""
		End If
	End Function
	'================================================
	'函数名：Re_Replace
	'作  用：替换代码
	'================================================
	Public Function Re_Replace(str,retxt,replacetxt)
		re.Pattern = Replace(Replace(retxt, "$", "\$"), "|", "\|")
		Re_Replace = re.Replace(str,replacetxt)
	End Function
	'================================================
	'函数名：FindMarked
	'作  用：查找匹配的标记
	'返回值：标记数组
	'================================================
	Public Function FindMarked(ByVal str, ByVal start, ByVal last,ByVal num)
		Dim Match, MatchCode, s
		Dim FilterStr, strPattern
		Dim ArrayCode
		Dim i, n, bRepeat
		
		On Error Resume Next
		If Len(start) > 0 And Len(last) > 0 And Len(str) > 0 Then
			re.Pattern = "([\f\n\r\t\v])"
			str = re.Replace(str,vbNullString)
			strPattern = "(" & CorrectPattern(start) & ")(.+?)(" & CorrectPattern(last) & ")"
			re.Pattern = strPattern
			Set s = re.Execute(str)
			n = 0
			For Each Match In s
				If num > 0 Then
					MatchCode = re.Replace(Match.value, "$" & num)
				Else
					MatchCode = Match.value
				End if
				If n = 0 Then
					ReDim ArrayCode(n)
					ArrayCode(n) = MatchCode
					n = n + 1
				Else
					bRepeat = False
					For i = 0 To UBound(ArrayCode)
						If UCase(MatchCode) = UCase(ArrayCode(i)) Then
							bRepeat = True
							Exit For
						End If
					Next
					If bRepeat = False Then
						ReDim Preserve ArrayCode(n)
						ArrayCode(n) = MatchCode
						n = n + 1
					End If
				End If
			Next
			Set s = Nothing
		End If
		If IsArray(ArrayCode) Then
			FindMarked = ArrayCode
		Else
			FindMarked = Array("No Data")
		End If
	End Function
	Private Function CorrectPattern(ByVal str)
		str = Replace(str, "\", "\\"):str = Replace(str, "$", "\$"):str = Replace(str, ")", "\)")
		str = Replace(str, "#", "\#"):str = Replace(str, "%", "\%"):str = Replace(str, "+", "\+")
		str = Replace(str, "^", "\^"):str = Replace(str, "&", "\&"):str = Replace(str, "(", "\(")
		str = Replace(str, "[", "\["):str = Replace(str, "]", "\]"):str = Replace(str, "<", "\<")
		str = Replace(str, ">", "\>"):str = Replace(str, ".", "\."):str = Replace(str, "/", "\/")
		str = Replace(str, "?", "\?"):str = Replace(str, "=", "\="):str = Replace(str, "|", "\|")
		CorrectPattern = str
	End Function
End Class
%>