|
|
|
I spent several hours to find some article to convert Source Code into HTML with different colorcode for keywords/literal/comment/function. But no luck and finally I wrote my own ColorCoding Engine. This article will show you how you can utilize power of Regular Expression to solve your very complex programming challanges.
This article assume that you have basic knowledge with Regular Expressions. if you are not familier with Regular Expression then please check out our Regular Expression Articles
Lets start with namespace declaration which we need while processsing the sourcecode |
We will use 2 mail Regular expression to accomplish out task. First we need to seperate code block and description block from given string.
This article assume that your code block is seperated by the following syntax |
To find codeblock from given string we will use following Regular Expression |
And to do colorcoding and replacement of unwanted characters we will use following RegX |
In this class there are 2 public function which we will use to process colorcode. |
Click here to copy the following block |
Public Function GetHTMLText(ByRef strInput As String, ByVal LangId As Integer) As String sb = New StringBuilder GetHTMLText = ProcessCodeBlock(LangId, strInput, True) End Function |
Now finally How to use this class |
Click here to copy the following block | Const LANG_VB=1 Const LANG_VBNET=2
Dim strCode as String Dim strFormattedOut as String Dim cc as New CColorCode("95%")
strCode ="Dim I as Integer" & vbCrLf & "Msgbox ""Hello World"""
strFormattedOut=cc.GetHTMLText(strCode,LANG_VB)
strCode =" This is just description «Code LangId=1» Dim I as Integer" & vbCrLf & "Msgbox ""Hello World"" «/Code»"
strFormattedOut=cc.GetHTMLTextEx(strCode)
|
I have used following style sheet classes for colorcoding |
Click here to copy the following block | /* VB/VB.net/C# ColorCoding */ .VBKW{ FONT-SIZE: 12px; COLOR: blue; FONT-FAMILY: 'Courier New' }
.VBSTR{ FONT-SIZE: 12px; COLOR: red; FONT-FAMILY: 'Courier New' }
.VBFUN{ FONT-SIZE: 12px; COLOR: maroon; FONT-FAMILY: 'Courier New' }
.VBCOMMENT{ FONT-SIZE: 12px; COLOR: Green; FONT-FAMILY: 'Courier New' }
/* ASP/ASP.net ColorCoding */ .ASPKW{ FONT-SIZE: 12px; COLOR: blue; FONT-FAMILY: 'Courier New' }
.ASPSTR{ FONT-SIZE: 12px; COLOR: red; FONT-FAMILY: 'Courier New' }
.ASPFUN{ FONT-SIZE: 12px; COLOR: maroon; FONT-FAMILY: 'Courier New' }
.ASPCOMMENT{ FONT-SIZE: 12px; COLOR: Green; FONT-FAMILY: 'Courier New' }
/* SQL ColorCoding */
.SQLKW{ FONT-SIZE: 12px; COLOR: blue; FONT-FAMILY: 'Courier New' } .SQLOPE { font-size: 12px; color: gray; font-family: 'Courier New'; }
.SQLSTR{ FONT-SIZE: 12px; COLOR: red; FONT-FAMILY: 'Courier New' }
.SQLFUN { font-size: 12px; color: fuchsia; font-family: 'Courier New'; }
.SQLCOMMENT{ FONT-SIZE: 12px; COLOR: Green; FONT-FAMILY: 'Courier New' } .SQLSP { font-size: 12px; color: maroon; font-family: 'Courier New'; }
.CODEBLOCK { font-size: 12px; color: black; font-family: 'Courier New'; background-color: #fbedbb; } .DESCBLOCK { font-size: 11px; color: black; font-family: tahoma; } |
Full implementation of CColorCode.vb |
Click here to copy the following block |
Option Explicit On
Imports System Imports System.Text Imports System.Web.HttpUtility Imports System.IO Imports Microsoft.VisualBasic Imports System.Diagnostics Imports System.Text.RegularExpressions
Public Class CColorCode
Public Event OnNewBlock(ByVal BlockText As String, ByVal BlockType As enumBlockType)
Dim ArticleDelegate As New MatchEvaluator(AddressOf BlockMatchHandler) Dim CodeBlockDelegate As New MatchEvaluator(AddressOf CodeBlockHandler) Dim DescBlockDelegate As New MatchEvaluator(AddressOf DescBlockHandler)
Dim codeblock_start_tag, codeblock_end_tag, description_start_tag, description_end_tag As String
Public Enum enumBlockType BLOCKNONE = 0 BLOCKDESC = 1 BLOCKCODE = 2 End Enum Public Enum WordListTypeEnum KEYWORDS = 0 OPERATORS = 1 FUNCTIONS = 2 End Enum
Public Enum LanguageEnum All = 0 VB = 1 VBnet = 2 CSharp = 3 ASPnet = 4 ASP = 5 SQL = 6 VCPlusPlus = 7 End Enum Dim fun_class, kw_class, str_class, comment_class, sp_class, ope_class As String Dim strKeyWordList, strFunctionList, strOperatorList As String
Dim tabSpaceCount As Byte Dim CurrentLangId As Integer Dim sb As StringBuilder Public Sub New(Optional ByVal tableWidth As String = "95%") codeblock_start_tag = "<TABLE borderColor=#fbedbb cellPadding=15 width=" & tableWidth & " bgColor=#fbedbb border=1 class=codeblock><tr><td>" codeblock_end_tag = "</td></tr></table>" description_start_tag = "<TABLE width=" & tableWidth & " bgColor=#ffffff border=0><tr><td><Span class=descblock>" description_end_tag = "</span></td></tr></table>" tabSpaceCount = 4 End Sub Public Function GetHTMLTextEx(ByRef strInput As String) As String sb = New StringBuilder GetHTMLTextEx = ProcessArticleBlocks(strInput) End Function Public Function GetHTMLText(ByRef strInput As String, ByVal LangId As Integer) As String sb = New StringBuilder GetHTMLText = ProcessCodeBlock(LangId, strInput, True) End Function Private Function GetTab() As String Dim i As Byte For i = 1 To tabSpaceCount If i Mod 2 = 0 Then GetTab = GetTab & " " Else GetTab = GetTab & " " End If Next End Function Private Function ProcessArticleBlocks(ByRef strInput As String) As String Dim strRegX As String = "((?<codestart>(«\s*)(code\s+)(LangId\s*=\s*)(?<langid>\d{1,2})\s*»)(?<code>(.|\n)*?)(?<codeend>(«\s*)(\/\s*code)\s*»))"
Dim cur_ptr, block_sptr, block_eptr As Integer Dim HasMoreBlock As Boolean Dim bCount As Integer Dim strDesc As String Dim re As New System.Text.RegularExpressions.Regex(strRegX, RegexOptions.IgnoreCase Or RegexOptions.Multiline Or RegexOptions.IgnorePatternWhitespace) Dim m As Match Dim PrevBlockType As enumBlockType Dim EndTagFound, StartTagFound, CodeFound As Boolean
strInput = TrimEx(strInput)
sb = New StringBuilder
block_sptr = 0 block_eptr = 0
If strInput.Length > 0 Then HasMoreBlock = True End If
Do While HasMoreBlock = True m = re.Match(strInput, block_sptr)
If m.Success Then HasMoreBlock = True cur_ptr = m.Index StartTagFound = IIf(m.Groups("codestart").Value <> "", True, False) EndTagFound = IIf(m.Groups("codeend").Value <> "", True, False) CodeFound = IIf(m.Groups("code").Value <> "", True, False)
If cur_ptr > block_sptr Then strDesc = TrimEx(strInput.Substring(block_sptr, cur_ptr - block_sptr)) If strDesc <> "" Then sb.Append (description_start_tag & ProcessDescBlock(strDesc) & description_end_tag) End If
If StartTagFound = True And EndTagFound = True And CodeFound = True Then sb.Append (BlockMatchHandler(m)) block_sptr = cur_ptr + m.Length Else block_sptr = cur_ptr + m.Length End If cur_ptr = block_sptr
Else If block_sptr < strInput.Length Then If cur_ptr = 0 Then strDesc = strInput.Substring(block_sptr, strInput.Length) If strDesc <> "" Then sb.Append (description_start_tag & ProcessDescBlock(strDesc) & description_end_tag) Else strDesc = TrimEx(strInput.Substring(block_sptr, strInput.Length - block_sptr)) If strDesc <> "" Then sb.Append (description_start_tag & ProcessDescBlock(strDesc) & description_end_tag) End If End If HasMoreBlock = False End If Loop
ProcessArticleBlocks = sb.ToString End Function
Private Function BlockMatchHandler(ByVal m As Match) As String If m.Groups("code").Value <> "" Then Select Case m.Groups("langid").Value Case LanguageEnum.VB, LanguageEnum.VBnet, LanguageEnum.CSharp BlockMatchHandler = codeblock_start_tag & ProcessCodeBlock(m.Groups("langid").Value, TrimEx(m.Groups("code").Value)) & codeblock_end_tag Case LanguageEnum.SQL BlockMatchHandler = codeblock_start_tag & ProcessCodeBlock(m.Groups("langid").Value, TrimEx(m.Groups("code").Value)) & codeblock_end_tag Case LanguageEnum.ASP, LanguageEnum.ASPnet BlockMatchHandler = codeblock_start_tag & ProcessCodeBlock(m.Groups("langid").Value, TrimEx(m.Groups("code").Value)) & codeblock_end_tag Case Else BlockMatchHandler = codeblock_start_tag & ProcessCodeBlock(m.Groups("langid").Value, TrimEx(m.Groups("code").Value)) & codeblock_end_tag End Select Else BlockMatchHandler = description_start_tag & ProcessDescBlock(m.Groups("desc").Value) & description_end_tag End If End Function
Private Function CodeBlockHandler(ByVal m As Match) As String Select Case CurrentLangId Case LanguageEnum.VB, LanguageEnum.CSharp, LanguageEnum.VBnet If m.Groups("kw").Value <> "" Then CodeBlockHandler = "<span class=" & kw_class & ">" & m.Groups("kw").Value & "</span>" ElseIf m.Groups("str").Value <> "" Then CodeBlockHandler = "<span class=" & str_class & ">" & GetHTMLEncodedStr(m.Groups("str").Value) & "</span>" ElseIf m.Groups("com").Value <> "" Then CodeBlockHandler = "<span class=" & comment_class & ">" & GetHTMLEncodedStr(m.Groups("com").Value) & "</span>" ElseIf m.Groups("twospace").Value <> "" Then CodeBlockHandler = " " & " " ElseIf m.Groups("space").Value <> "" Then CodeBlockHandler = " " ElseIf m.Groups("tab").Value = vbTab Then CodeBlockHandler = GetTab() ElseIf m.Groups("newline").Value = vbCrLf Then CodeBlockHandler = "<BR>" ElseIf m.Groups("lt").Value <> "" Then CodeBlockHandler = "<" ElseIf m.Groups("gt").Value <> "" Then CodeBlockHandler = ">" Else CodeBlockHandler = m.ToString End If
Case LanguageEnum.ASP, LanguageEnum.ASPnet If m.Groups("kw").Value <> "" Then CodeBlockHandler = "<span class=" & kw_class & ">" & m.Groups("kw").Value & "</span>" ElseIf m.Groups("fun").Value <> "" Then CodeBlockHandler = "<span class=" & fun_class & ">" & m.Groups("fun").Value & "</span>" ElseIf m.Groups("str").Value <> "" Then CodeBlockHandler = "<span class=" & str_class & ">" & GetHTMLEncodedStr(m.Groups("str").Value) & "</span>" ElseIf m.Groups("com").Value <> "" Then CodeBlockHandler = "<span class=" & comment_class & ">" & GetHTMLEncodedStr(m.Groups("com").Value) & "</span>" ElseIf m.Groups("twospace").Value <> "" Then CodeBlockHandler = " " & " " ElseIf m.Groups("space").Value <> "" Then CodeBlockHandler = " " ElseIf m.Groups("tab").Value = vbTab Then CodeBlockHandler = GetTab() ElseIf m.Groups("newline").Value = vbCrLf Then CodeBlockHandler = "<BR>" ElseIf m.Groups("lt").Value <> "" Then CodeBlockHandler = "<" ElseIf m.Groups("gt").Value <> "" Then CodeBlockHandler = ">" Else CodeBlockHandler = m.ToString End If
Case LanguageEnum.SQL If m.Groups("kw").Value <> "" Then CodeBlockHandler = "<span class=" & kw_class & ">" & m.Groups("kw").Value & "</span>" ElseIf m.Groups("fun").Value <> "" Then CodeBlockHandler = "<span class=" & fun_class & ">" & m.Groups("fun").Value & "</span>" ElseIf m.Groups("ope").Value <> "" Then CodeBlockHandler = "<span class=" & ope_class & ">" & m.Groups("ope").Value & "</span>" ElseIf m.Groups("str").Value <> "" Then CodeBlockHandler = "<span class=" & str_class & ">" & GetHTMLEncodedStr(m.Groups("str").Value) & "</span>" ElseIf m.Groups("com").Value <> "" Then CodeBlockHandler = "<span class=" & comment_class & ">" & GetHTMLEncodedStr(m.Groups("com").Value) & "</span>" ElseIf m.Groups("sp").Value <> "" Then CodeBlockHandler = "<span class=" & sp_class & ">" & m.Groups("sp").Value & "</span>" ElseIf m.Groups("twospace").Value <> "" Then CodeBlockHandler = " " & " " ElseIf m.Groups("space").Value <> "" Then CodeBlockHandler = " " ElseIf m.Groups("tab").Value = vbTab Then CodeBlockHandler = GetTab() ElseIf m.Groups("newline").Value = vbCrLf Then CodeBlockHandler = "<BR>" ElseIf m.Groups("lt").Value <> "" Then CodeBlockHandler = "<" ElseIf m.Groups("gt").Value <> "" Then CodeBlockHandler = ">" Else CodeBlockHandler = m.ToString End If
End Select End Function Private Function GetHTMLEncodedStr(ByVal inStr As String) As String GetHTMLEncodedStr = inStr.Replace("<", "<").Replace(">", ">").Replace(" ", " ").Replace(vbCrLf, "<BR>").Replace(vbTab, GetTab()) End Function Private Function DescBlockHandler(ByVal m As Match) As String If m.Groups("str").Value <> "" Then DescBlockHandler = "<span class=" & str_class & ">" & m.Groups("str").Value & "</span>" ElseIf m.Groups("twospace").Value <> "" Then DescBlockHandler = " " & " " ElseIf m.Groups("tab").Value = vbTab Then DescBlockHandler = GetTab() ElseIf m.Groups("newline").Value = vbCrLf Then DescBlockHandler = "<BR>" ElseIf m.Groups("lt").Value <> "" Then DescBlockHandler = "<" ElseIf m.Groups("gt").Value <> "" Then DescBlockHandler = ">" Else DescBlockHandler = m.ToString End If End Function Private Function ProcessCodeBlock(ByVal LangId As Integer, ByRef strCodeBlock As String, Optional ByVal AddTags As Boolean = False) As String CurrentLangId = LangId Select Case LangId Case LanguageEnum.VB, LanguageEnum.VBnet, LanguageEnum.CSharp kw_class = "vbkw" fun_class = "vbfun" str_class = "vbstr" comment_class = "vbcomment" sp_class = "" ope_class = "vbope" Case LanguageEnum.ASP, LanguageEnum.ASPnet kw_class = "aspkw" fun_class = "aspfun" str_class = "aspstr" comment_class = "aspcomment" sp_class = "" ope_class = "" Case LanguageEnum.SQL kw_class = "sqlkw" fun_class = "sqlfun" str_class = "sqlstr" comment_class = "sqlcomment" sp_class = "sqlsp" ope_class = "sqlope"
Case Else fun_class = "" kw_class = "" str_class = "vbstr" comment_class = "" sp_class = "" ope_class = "" End Select
Dim strRegX As String strRegX = GetRegX(LangId) Dim re As New System.Text.RegularExpressions.Regex(strRegX, RegexOptions.IgnoreCase Or RegexOptions.IgnorePatternWhitespace Or RegexOptions.Multiline)
If AddTags = True Then ProcessCodeBlock = codeblock_start_tag & re.Replace(strCodeBlock, CodeBlockDelegate) & codeblock_end_tag Else ProcessCodeBlock = re.Replace(strCodeBlock, CodeBlockDelegate) End If End Function Private Function ProcessDescBlock(ByRef strDescBlock As String) str_class = "" Dim strRegX As String = GetRegX() Dim re As New System.Text.RegularExpressions.Regex(strRegX, RegexOptions.IgnoreCase Or RegexOptions.IgnorePatternWhitespace Or RegexOptions.Multiline) ProcessDescBlock = re.Replace(strDescBlock, DescBlockDelegate) End Function Private Function GetWordList(LangId As Integer, WordType As WordListTypeEnum) Select Case LangId Case 1 Select Case WordType Case 0 GetWordList = "DIM|INTEGER|WHILE|LOOP|FOR|IF|ELSE" Case 1 Case 2 End Select Case 2 Select Case WordType Case 0 GetWordList = "DIM|INTEGER|WHILE|LOOP|FOR|IF|ELSE" Case 1 Case 2 End Select Case 6 Select Case WordType Case 0 GetWordList = "SELECT|FROM|WHILE|LOOP|BEGIN" Case 1 GetWordList = "AND|OR|NOT" Case 2 GetWordList = "COUNT|MIN|MAX|SUM" End Select
Case Else End Select End Function Private Function GetRegX(Optional ByVal LangId As Integer = 0) As String
Dim strRegX As String Dim WordLookuptable As DataTable If LangId > 0 Then strKeyWordList = GetWordList(LangId, WordListTypeEnum.KEYWORDS).Replace("#", "\#") strFunctionList = GetWordList(LangId, WordListTypeEnum.FUNCTIONS).Replace("#", "\#") strOperatorList = GetWordList(LangId, WordListTypeEnum.OPERATORS).Replace("#", "\#") End If
Select Case LangId Case LanguageEnum.VB, LanguageEnum.VBnet strRegX = "(?<twospace>\x20\x20)(?#HTML only put one space and for second space use & nbsp;)" & vbCrLf & _ "|(?<newline>\r\n) (?#we need to put <BR> for new line)" & vbCrLf & _ "|(?<tab>\t) (?#html doesnt display Tab character so put some spaces instead of tab )" & vbCrLf & _ "|(?<space>\x20)" & vbCrLf & _ "|(?<lt><)" & vbCrLf & _ "|(?<gt>>)" & vbCrLf & _ "|(?<kw>\b(" & strKeyWordList & ")\b) (?#Keywords)" & vbCrLf & _ "|(?<fun>\b(" & strFunctionList & ")\b) (?#Functions)" & vbCrLf & _ "|(?<ope>\b(" & strOperatorList & ")\b) (?#Operators)" & vbCrLf & _ "|(?<str>(""[^""]*"")) (?#String in double quotes)" & vbCrLf & _ "|(?<com>('[^\r]*)(\r\n)?) (?#VB/VB.net single line style comment)"
Case LanguageEnum.ASP, LanguageEnum.ASPnet strRegX = "(?<twospace>\x20\x20)(?#HTML only put one space and for second space use & nbsp;)" & vbCrLf & _ "|(?<newline>\r\n) (?#we need to put <BR> for new line)" & vbCrLf & _ "|(?<tab>\t) (?#html doesnt display Tab character so put some spaces instead of tab )" & vbCrLf & _ "|(?<space>\x20)" & vbCrLf & _ "|(?<lt>\<)" & vbCrLf & _ "|(?<gt>\>)" & vbCrLf & _ "|(?<kw>\b(" & strKeyWordList & ")\b) (?#Keywords)" & vbCrLf & _ "|(?<fun>\b(" & strFunctionList & ")\b) (?#Functions)" & vbCrLf & _ "|(?<ope>\b(" & strOperatorList & ")\b) (?#Operators)" & vbCrLf & _ "|(?<str>('[^']*')) (?#String in single quotes)" & vbCrLf & _ "|(?<com><!--[\s\S]*?-->) (?#ASP/ASP.net/HTML block comment)"
Case LanguageEnum.CSharp, LanguageEnum.VCPlusPlus strRegX = "(?<twospace>\x20\x20)(?#HTML only put one space and for second space use & nbsp;)" & vbCrLf & _ "|(?<newline>\r\n) (?#we need to put <BR> for new line)" & vbCrLf & _ "|(?<tab>\t) (?#html doesnt display Tab character so put some spaces instead of tab )" & vbCrLf & _ "|(?<space>\x20)" & vbCrLf & _ "|(?<lt>\<)" & vbCrLf & _ "|(?<gt>\>)" & vbCrLf & _ "|(?<kw>\b(" & strKeyWordList & ")\b) (?#Keywords)" & vbCrLf & _ "|(?<fun>\b(" & strFunctionList & ")\b) (?#Functions)" & vbCrLf & _ "|(?<ope>\b(" & strOperatorList & ")\b) (?#Operators)" & vbCrLf & _ "|(?<str>(""[^""]*"")) (?#String in double quotes)" & vbCrLf & _ "|(?<com>/\*[\d\D]*?\*/) (?#SQL/C#/C++ Block style comment)" & vbCrLf & _ "|(?<com>(\/\/[^\r]*)(\r\n)?) (?#C++ single line style comment)"
Case LanguageEnum.SQL strRegX = "(?<twospace>\x20\x20)(?#HTML only put one space and for second space use & nbsp;)" & vbCrLf & _ "|(?<newline>\r\n) (?#we need to put <BR> for new line)" & vbCrLf & _ "|(?<tab>\t) (?#html doesnt display Tab character so put some spaces instead of tab )" & vbCrLf & _ "|(?<space>\x20)" & vbCrLf & _ "|(?<lt>\<)" & vbCrLf & _ "|(?<gt>\>)" & vbCrLf & _ "|(?<kw>\b(" & strKeyWordList & ")\b) (?#Keywords)" & vbCrLf & _ "|(?<fun>\b(" & strFunctionList & ")\b) (?#Functions)" & vbCrLf & _ "|(?<ope>\b(" & strOperatorList & ")\b) (?#Operators)" & vbCrLf & _ "|(?<str>('[^']*')) (?#String in double quotes)" & vbCrLf & _ "|(?<com>/\*[\d\D]*?\*/) (?#SQL/C#/C++ Block style comment)" & vbCrLf & _ "|(?<com>(--[^\r]*)(\r\n)?) (?#SQL single line style comment)" & vbCrLf & _ "|(?<sp>\b((sp_)|(xp_))[0-9 a-z A-Z]{0,125}\b\s*) (?#SQL stored procedure starting with sp_ or xp_ maximum 128 characters allowed)"
Case Else strRegX = "(?<twospace>\x20\x20)(?#HTML only put one space and for second space use & nbsp;)" & vbCrLf & _ "|(?<newline>\r\n) (?#we need to put <BR> for new line)" & vbCrLf & _ "|(?<tab>\t) (?#html doesnt display Tab character so put some spaces instead of tab )" & vbCrLf & _ "|(?<lt>\<)" & vbCrLf & _ "|(?<gt>\>)" & vbCrLf & _ "|(?<str>(""[^""]*"")) (?#String in double quotes)" End Select GetRegX = strRegX End Function Private Function TrimEx(ByRef inString As String) As String If inString = "" Then Exit Function Dim reg1 As String = "^(\s*)([\W\w]*)(\b\s*$)"
Dim re As New System.Text.RegularExpressions.Regex(reg1)
TrimEx = re.Replace(inString, "$2") End Function End Class |
|
|
|
Submitted By :
Nayan Patel
(Member Since : 5/26/2004 12:23:06 PM)
|
|
|
Job Description :
He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting. |
View all (893) submissions by this author
(Birth Date : 7/14/1981 ) |
|
|