www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/inc/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 %>