Class EMarkupParser

Private m_colTags
Private m_objRxp
Private m_strTagLIst
Private m_blnURLify
Private m_blnAllowHTML
Private m_strTarget

Public Property Let URLify(DoURLify)
m_blnURLify=DoURLify
End Property

Public Property Let AllowHTML(DoAllowHTML)
m_blnAllowHTML=DoAllowHTML
End Property

Public Property Let Target(LinkTarget)
m_strTarget=LinkTarget
End Property

Private Sub AddToList(TagName)
m_strTagLIst=m_strTagLIst & "|" & TagName
End Sub

Private Property Get TagList
If len(m_strTagLIst)>1 Then
TagLIst=mid(m_strTagLIst,2)
Else
TagLIst=""
End If
End Property

Public Sub AddTag(TagName,Replacement,ParseContents)
Dim s_objTag
Set s_objTag=new ETag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Sub AddAttrTag(TagName,Replacement,ParseContents)
Dim s_objTag
Set s_objTag=new EAttrTag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Sub AddSingleTag(TagName,Replacement)
Dim s_objTag
Set s_objTag=new ESingleTag
Set s_objTag.Parser=Me
s_objTag.TagName=TagName
s_objTag.Replacement=Replacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
End Sub

Public Sub AddQuickTag(StartTag,EndTag,StartReplacement,EndReplacement,ParseContents)
Dim s_objTag
Set s_objTag=new EQuickTag
Set s_objTag.Parser=Me
s_objTag.StartTag=StartTag
s_objTag.EndTag=EndTag
s_objTag.StartReplacement=StartReplacement
s_objTag.EndReplacement=EndReplacement
m_colTags.Add cstr(m_colTags.Count),s_objTag
If not ParseContents Then AddToList(TagName)
End Sub

Public Function Parse(TextToParse)
dim f_strText,f_strTag
f_strText=TextToParse
f_strText=Replace(f_strText,"##",chr(1))
If Not m_blnAllowHTML Then
f_strText=Replace(f_strText,"<","&lt;")
f_strText=Replace(f_strText,">","&gt;")
End If
m_objRxp.Pattern="(\[(" & TagLIst & ")(=[^\]]*?)?\])(.*?)(\[/\2\])"
For Each f_objMatch in m_objRxp.Execute(f_strText)
f_strText=Replace(f_strText,f_objMatch.Value,f_objMatch.Submatches(0) & Replace(f_objMatch.Submatches(3),"[",chr(0)) & f_objMatch.Submatches(4))
Next
For Each f_objTag in m_colTags
f_strText=m_colTags(f_objTag).Parse(f_strText,m_objRxp)
Next
If m_blnURLIfy Then
f_strText=ParseURLs(Replace(Replace(f_strText,chr(0),"["),chr(1),"##"),m_strTarget)
Else
f_strText=Replace(Replace(f_strText,chr(0),"["),chr(1),"##")
End If

Parse=Replace(f_strText,vbcrlf,"<br />")
'	Parse = f_strText
End Function

Public Function ParseURLs(TextToParse,LinkTarget)
dim f_strText
f_strText=TextToParse
m_objRxp.Pattern="(^|[^""])(http://|https://|ftp://|mailto:|file://|telnet://|gopher://)([\w/#~:.,?+=&%@!\-]*?)([\s.:?\-]*[^\w/#~:.,?+=&%@!\-]|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a target=""" & LinkTarget & """ href=""$2$3"">$2$3</a>$4")
m_objRxp.Pattern="(^|[^\w/>])(www\.[\w/#~:.,?+=&%@!\-]*?)([\s.:?\-]*[^\w/#~:.,?+=&%@!\-]|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a target=""" & LinkTarget & """ href=""http://$2"">$2</a>$3")
'objRxp.Pattern = "(\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+)"
m_objRxp.Pattern="(^|[^:>\w])([\w\.]*@[\w\.\-]*\.\w{2,3})(\b|$)"
f_strText=m_objRxp.Replace(f_strText,"$1<a href=""mailto:$2"">$2</a>")
ParseURLs=f_strText
End Function

Public Function RegExpEncode(TextToParse)
m_objRxp.Pattern="([\\\^\$\*\+\?\.\(\)\|\{\}\[\]])"
RegExpEncode=m_objRxp.Replace(TextToParse,"\$1")
End Function

Private Sub Class_Initialize
Set m_colTags=Server.CreateObject("Scripting.Dictionary")
Set m_objRxp=New RegExp
m_objRxp.Global=True
m_objRxp.IgnoreCase=True
m_objRxp.Multiline=True
m_strTarget="_blank"
m_blnAllowHTML=false
m_blnURLify=true
End Sub

End Class

Class ETag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
Dim f_strPattern
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
f_strPattern=Replace(Replacement,"##contents##","$1")
objRxp.Pattern="\[" & c_strTag & "\]((.|\s)*?)\[/" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,f_strPattern)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class EAttrTag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
Dim m_strPattern
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
m_strPattern=Replace(Replace(Replacement,"##contents##","$2"),"##attr##","$1")
objRxp.Multiline=true
objRxp.Pattern="\[" & c_strTag & "=([^\]]*?)\]((.|\s)*?)\[/" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,m_strPattern)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class ESingleTag
Public TagName
Public Replacement
Public Parser
Private c_strTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
If Parser Is Nothing Then
c_strTag=TagName
Else
c_strTag=Parser.RegExpEncode(TagName)
End If
objRxp.Pattern="\[" & c_strTag & "\]"
Parse=objRxp.Replace(TextToParse,Replacement)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class

Class EQuickTag
Public StartTag
Public EndTag
Public StartReplacement
Public EndReplacement
Public Parser
Private c_strStartTag
Private c_strEndTag
Public Function Parse(TextToParse,objRxp)
On Error Resume Next
If Parser Is Nothing Then
c_strStartTag=StartTag
c_strEndTag=EndTag
Else
c_strStartTag=Parser.RegExpEncode(StartTag)
c_strEndTag=Parser.RegExpEncode(EndTag)
End If
objRxp.Pattern="\[" & c_strStartTag & "\]((.|\s)*?)\[/" & c_strEndTag & "\]"
Parse=objRxp.Replace(TextToParse,StartReplacement & "$1" & EndReplacement)
If Err.Number<>0 Then Parse=TextToParse
End Function
End Class


Set wfParser=New EMarkupParser
With wfParser

.URLIfy=true
.Target="_blank"

.AddQuickTag "b","b","<b>","</b>",true
.AddQuickTag "i","i","<i>","</i>",true
.AddQuickTag "u","u","<u>","</u>",true
.AddQuickTag "s","s","<s>","</s>",true

.AddQuickTag "1","1","<span style=""font: 8px arial;"">","</span>",true
.AddQuickTag "2","2","<span style=""font: 10px arial;"">","</span>",true
.AddQuickTag "3","3","<span style=""font: 12px arial;"">","</span>",true
.AddQuickTag "4","4","<span style=""font: 14px arial;"">","</span>",true
.AddQuickTag "5","5","<span style=""font: 16px arial;"">","</span>",true
.AddQuickTag "6","6","<span style=""font: 18px arial;"">","</span>",true
.AddQuickTag "7","7","<span style=""font: 20px arial;"">","</span>",true
.AddQuickTag "8","8","<span style=""font: 22px arial;"">","</span>",true
.AddQuickTag "9","9","<span style=""font: 24px arial;"">","</span>",true

.AddTag "img","<div class=""smallfont"" style=""margin-bottom:2px"">Länkad bild:</div><div class=""extPic""><img src=""##contents##""></div>",false
.AddAttrTag "img","<div class=""smallfont"" style=""margin-bottom:2px"">Länkad bild:</div><div class=""extPic""><img alt=""##attr##"" src=""##contents##""></div>",false

.AddTag "email","<a href=""mailto:##contents##"">##contents##</a>",false
.AddAttrTag "email","<a href=""mailto:##attr##"">##contents##</a>",false

.AddTag "url","<a target=""_blank"" href=""##contents##"">##contents##</a>",false
.AddAttrTag "url","<a target=""_blank"" href=""##attr##"">##contents##</a>",false

.AddQuickTag "list","list","<ul type=""dot"" class=""wF_Parser_List"">","</ul>",true
.AddQuickTag "list=A","list","<ol type=""A"">","</ol>",true
.AddQuickTag "list=1","list","<ol type=""1"">","</ol>",true
.AddQuickTag "*","*","<li>","</li>",true

.AddQuickTag "red","red","<span style=""color: red;"">","</span>",true
.AddQuickTag "blue","blue","<span style=""color: blue;"">","</span>",true
.AddQuickTag "yellow","yellow","<span style=""color: yellow;"">","</span>",true
.AddQuickTag "white","white","<span style=""color: white;"">","</span>",true
.AddQuickTag "green","green","<span style=""color: green;"">","</span>",true
.AddAttrTag "color","<span style=""color: ##attr##;"">##contents##</span>",false

'.AddSingleTag "*","<li>"
.AddQuickTag "code","code","<div class=""smallfont"" style=""margin-bottom:2px"">Kod:</div><div class=""code""><pre class=""alt2"" style=""margin:0px; padding:6px;"">",VbCrlf & "</pre></div>",true

.AddQuickTag "icon","icon","<img src=""",""" alt=""Smiley"">",true

'.AddQuickTag "perl","perl","<BLOCKQUOTE><font size=""1"" face=""Verdana, Arial, Helvetica, sans-serif"">kod:</font><HR><code><pre><BR>","</pre></code><HR></BLOCKQUOTE>",true
.AddQuickTag "quote","quote","<div class=""smallfont"" style=""margin-bottom:2px"">Citat:</div><div class=""quote""><pre class=""alt2"" style=""margin:0px; padding:6px;"">",VbCrlf & "</pre></div>",true
.AddAttrTag "quote","<div class=""smallfont"" style=""margin-bottom:2px"">##attr## <span style=""font-style: italic;"">säger:</span></div><div class=""quote""><pre class=""alt2"" style=""margin:0px; padding:6px;"">##contents##</pre></div>",false
End With