From DotNetJunkie XL on the 7th Floor

Option

Explicit On

Imports

System

Imports

System.Web

Imports

System.Text

Imports

System.Text.RegularExpressions

Public

Class cCodeToHTML

Private _ShowFileName As Boolean = False

Private _FontSize As Integer = 3

Private _Language As String = ""

Private Const TAG_FNTRED As String = "<font color=""red"">"

Private Const TAG_FNTBLUE As String = "<font color=""blue"">"

Private Const TAG_FNTGRN As String = "<font color=""green"">"

Private Const TAG_FNTMRN As String = "<font color=""maroon"">"

Private Const TAG_EFONT As String = "</font>"

Public Property ShowFileName() As Boolean

Get

Return _ShowFileName

End Get

Set(ByVal Value As Boolean)

_ShowFileName = Value

End Set

End Property

Public Property FontSize() As Integer

Get

Return _FontSize

End Get

Set(ByVal Value As Integer)

_FontSize = Value

End Set

End Property

Public Property Language() As String

Get

Return _Language

End Get

Set(ByVal Value As String)

_Language = Value

End Set

End Property

Private Sub SetLanguageFromFileName(ByVal FilePath As String)

' Find the current language from the file extension

If FilePath.Split(Convert.ToChar(".")).Length > 0 Then

Dim sFileExtension As String = FilePath.Substring(FilePath.LastIndexOf(Convert.ToChar(".")) + 1)

Select Case sFileExtension.ToLower().Trim()

Case ProgrammingLanguage.VB

_Language = ProgrammingLanguage.VB

Case ProgrammingLanguage.CSharp

_Language = ProgrammingLanguage.CSharp

Case ProgrammingLanguage.JSharp

_Language = ProgrammingLanguage.JSharp

End Select

End If

End Sub

Public Overloads Function RenderFile(ByVal FilePath As String) As String

' errors?

SetLanguageFromFileName(FilePath)

Return Render(IO.File.OpenText(FilePath))

End Function

Public Overloads Sub RenderFile(ByVal FilePath As String, ByVal OutputFilePath As String)

' Render and throw error

SetLanguageFromFileName(FilePath)

Dim MyStreamWriter As New IO.StreamWriter(OutputFilePath)

MyStreamWriter.Write(Render(IO.File.OpenText(FilePath)))

MyStreamWriter.Flush()

MyStreamWriter.Close()

End Sub

Public Overloads Function Render(ByVal InputTextReader As IO.StreamReader) As String

Return Render(InputTextReader.ReadToEnd())

End Function

Public Overloads Function Render(ByVal InputString As String) As String

Dim MyStringBuilder As New System.Text.StringBuilder()

Dim MyStringWriter As New System.IO.StringWriter(MyStringBuilder)

' Split into a string array for processing

Dim InputLines() As String = InputString.Split(vbCrLf)

Dim sInputLine As String

' Write out the font size

MyStringWriter.WriteLine(

"<font size=""" & _FontSize & """ \>")

' Process the language

Select Case _Language.Trim.ToLower()

Case ProgrammingLanguage.CSharp

MyStringWriter.WriteLine(

"<pre>")

For Each sInputLine In InputLines

MyStringWriter.Write(FixCSLine(sInputLine))

Next

MyStringWriter.WriteLine(

"</pre>")

Case ProgrammingLanguage.JSharp

MyStringWriter.WriteLine(

"<pre>")

For Each sInputLine In InputLines

MyStringWriter.Write(FixJSLine(sInputLine))

Next

MyStringWriter.WriteLine(

"</pre>")

Case ProgrammingLanguage.VB

MyStringWriter.WriteLine(

"<pre>")

For Each sInputLine In InputLines

MyStringWriter.Write(FixVBLine(sInputLine))

Next

MyStringWriter.WriteLine(

"</pre>")

Case Else

Dim bIsInScriptBlock As Boolean = False

Dim bIsInMultiLine As Boolean = False

MyStringWriter.WriteLine(

"<pre>")

For Each sInputLine In InputLines

' get the global language from a page directive

_Language = GetLanguageFromLine(sInputLine, _Language)

If IsScriptBlockTagStart(sInputLine) Then

MyStringWriter.Write(FixASPXLine(sInputLine))

bIsInScriptBlock =

True

ElseIf IsScriptBlockTagEnd(sInputLine) Then

MyStringWriter.Write(FixASPXLine(sInputLine))

bIsInScriptBlock =

False

ElseIf IsMultiLineTagStart(sInputLine) And bIsInMultiLine = False Then

MyStringWriter.Write(

"<font color=blue><b>" + HttpUtility.HtmlEncode(sInputLine))

bIsInMultiLine =

True

ElseIf IsMultiLineTagEnd(sInputLine) And bIsInMultiLine = True Then

MyStringWriter.Write(HttpUtility.HtmlEncode(sInputLine) +

"</b></font>")

bIsInMultiLine =

False

ElseIf bIsInMultiLine Then

MyStringWriter.Write(HttpUtility.HtmlEncode(sInputLine))

Else

If bIsInScriptBlock Then

Select Case _Language.Trim.ToLower()

Case ProgrammingLanguage.CSharp

MyStringWriter.Write(FixCSLine(sInputLine))

Case ProgrammingLanguage.JSharp

MyStringWriter.Write(FixJSLine(sInputLine))

Case ProgrammingLanguage.VB

MyStringWriter.Write(FixVBLine(sInputLine))

Case Else

MyStringWriter.Write(FixVBLine(sInputLine))

End Select

Else

MyStringWriter.Write(FixASPXLine(sInputLine))

End If

End If

Next

MyStringWriter.WriteLine(

"</pre>")

'aspx-page sorted out

End Select

MyStringWriter.WriteLine(

"</font>")

MyStringWriter.Flush()

Return MyStringBuilder.ToString()

End Function

Private Function GetLanguageFromLine(ByVal sInputLine As String, ByVal DefaultLanguage As String) As String

' Returns name of the language

Dim sReturn As String = DefaultLanguage

If sInputLine.Length = 0 Then

Return sReturn

End If

Dim LanguageMatch As Match = RegularExpressions.Regex.Match(sInputLine, "(?i)<%@\s*Page\s*.*Language\s*=\s*""(?<lang>[^""]+)""")

If LanguageMatch.Success Then

sReturn = LanguageMatch.Groups(

"lang").ToString()

End If

LanguageMatch = RegularExpressions.Regex.Match(sInputLine,

"(?i)(?=.*runat\s*=\s*""?server""?)<script.*language\s*=\s*""(?<lang>[^""]+)"".*>")

If LanguageMatch.Success Then

sReturn = LanguageMatch.Groups(

"lang").ToString()

End If

LanguageMatch = RegularExpressions.Regex.Match(sInputLine,

"(?i)<%@\s*WebService\s*.*Language\s*=\s*""?(?<lang>[^""]+)""?")

If LanguageMatch.Success Then

sReturn = LanguageMatch.Groups(

"lang").ToString()

End If

' "CS" instead of "C#" ?

If sReturn = "CS" Then

sReturn = ProgrammingLanguage.CSharp

End If

Return sReturn

End Function

Private Function FixCSLine(ByVal sInputLine As String) As String

Dim sOutput As String = sInputLine

If sInputLine.Length = 0 Then

Return sInputLine

End If

sOutput = Regex.Replace(sInputLine,

"(?i)(\t)", " ")

sOutput = HttpUtility.HtmlEncode(sOutput)

Dim sKeywords() As String = {"private", "protected", "public", "namespace", "class", "break", "for", "if", "else", "while", "switch", "case", "using", "return", "null", "void", "int", "bool", "string", "float", "this", "new", "true", "false", "const", "static", "base", "foreach", "in", "try", "catch", "get", "set", "char", "default"}

Dim sCombinedKeywords As String = "(?<keyword>" & String.Join("|", sKeywords) & ")"

sOutput = Regex.Replace(sOutput,

"\b" & sCombinedKeywords & "\b(?<!//.*)", TAG_FNTBLUE & "${keyword}" & TAG_EFONT)

sOutput = Regex.Replace(sOutput,

"(?<comment>//.*$)", TAG_FNTGRN & "${comment}" & TAG_EFONT)

Return sOutput

End Function

Private Function FixJSLine(ByVal sInputLine As String) As String

Dim sOutput As String = sInputLine

If sInputLine.Length = 0 Then

Return sInputLine

End If

sOutput = Regex.Replace(sInputLine,

"(?i)(\t)", " ")

sOutput = HttpUtility.HtmlEncode(sOutput)

Dim sKeywords() As String = {"private", "protected", "public", "namespace", "class", "var", "for", "if", "else", "while", "switch", "case", "using", "get", "return", "null", "void", "int", "string", "float", "this", "set", "new", "true", "false", "const", "static", "package", "function", "internal", "extends", "super", "import", "default", "break", "try", "catch", "finally"}

Dim sCombinedKeywords As String = "(?<keyword>" & String.Join("|", sKeywords) & ")"

sOutput = Regex.Replace(sOutput,

"\b" + sCombinedKeywords + "\b(?<!//.*)", TAG_FNTBLUE + "${keyword}" + TAG_EFONT)

sOutput = Regex.Replace(sOutput,

"(?<comment>//.*$)", TAG_FNTGRN + "${comment}" + TAG_EFONT)

Return sOutput

End Function

Private Function FixVBLine(ByVal sInputLine As String) As String

Dim sOutput As String = sInputLine

If sInputLine.Length = 0 Then

Return sInputLine

End If

sOutput = Regex.Replace(sInputLine,

"(?i)(\t)", " ")

sOutput = HttpUtility.HtmlEncode(sOutput)

Dim sKeywords() As String = {"AddressOf", "Delegate", "Optional", "ByVal", "ByRef", "Decimal", "Boolean", "Option", "Compare", "Binary", "Text", "On", "Off", "Explicit", "Strict", "Private", "Protected", "Public", "End Namespace", "Namespace", "End Class", "Exit", "Class", "Goto", "Try", "Catch", "End Try", "For", "End If", "If", "Else", "ElseIf", "Next", "While", "And", "Do", "Loop", "Dim", "As", "End Select", "Select", "Case", "Or", "Imports", "Then", "Integer", "Long", "String", "Overloads", "True", "Overrides", "End Property", "End Sub", "End Function", "Sub", "Me", "Function", "End Get", "End Set", "Get", "Friend", "Inherits", "Implements", "Return", "Not", "New", "Shared", "Nothing", "Finally", "False", "Me", "My", "MyBase", "End Enum", "Enum"}

Dim CombinedKeywords As String = "(?<keyword>" + String.Join("|", sKeywords) + ")"

sOutput = Regex.Replace(sOutput,

"(?i)\b" + CombinedKeywords + "\b(?<!'.*)", TAG_FNTBLUE + "${keyword}" + TAG_EFONT)

sOutput = Regex.Replace(sOutput,

"(?<comment>'(?![^']*&quot;).*$)", TAG_FNTGRN + "${comment}" + TAG_EFONT)

Return sOutput

End Function

Private Function FixASPXLine(ByVal sInputLine As String) As String

Dim sOutput As String = sInputLine

Dim sSearchExpression As String

Dim sReplaceExpression As String

If sInputLine.Length = 0 Then

Return sInputLine

End If

' Search for \t and replace it with 4 spaces

sOutput = Regex.Replace(sOutput,

"(?i)(\t)", " ")

sOutput = HttpUtility.HtmlEncode(sOutput)

' Single line comment or #include references.

sSearchExpression =

"(?i)(?<a>(^.*))(?<b>(&lt;!--))(?<c>(.*))(?<d>(--&gt;))(?<e>(.*))"

sReplaceExpression =

"${a}" & TAG_FNTGRN & "${b}${c}${d}" & TAG_EFONT & "${e}"

If Regex.IsMatch(sOutput, sSearchExpression) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colorize <%@ <type>

sSearchExpression =

"(?i)" + "(?<a>(&lt;%@))" + "(?<b>(.*))" + "(?<c>(%&gt;))"

sReplaceExpression =

"<font color=blue><b>${a}${b}${c}</b></font>"

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colorize <%# <type>

sSearchExpression =

"(?i)" + "(?<a>(&lt;%#))" + "(?<b>(.*))" + "(?<c>(%&gt;))"

sReplaceExpression =

"${a}" + "<font color=red><b>" + "${b}" + "</b></font>" + "${c}"

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colorize tag <type>

sSearchExpression =

"(?i)" + "(?<a>(&lt;)(?!%)(?!/?asp:)(?!/?template)(?!/?property)(?!/?ibuyspy:)(/|!)?)" + "(?<b>[^;\s&]+)" + "(?<c>(\s|&gt;|\Z))"

sReplaceExpression =

"${a}" + TAG_FNTMRN + "${b}" + TAG_EFONT + "${c}"

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colorize asp:|template for runat=server tags <type>

sSearchExpression =

"(?i)(?<a>&lt;/?)(?<b>(asp:|template|property|IBuySpy:).*)(?<c>&gt;)?"

sReplaceExpression =

"${a}" + TAG_FNTBLUE + "<b>${b}</b>" + TAG_EFONT + "${c}"

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colourise begin of tag char(s) "<","</","<%"

sSearchExpression =

"(?i)(?<a>(&lt;)(/|!|%)?)"

sReplaceExpression = TAG_FNTBLUE +

"${a}" + TAG_EFONT

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

' Colorize end of tag char(s) ">","/>"

sSearchExpression =

"(?i)(?<a>(/|%)?(&gt;))"

sReplaceExpression = TAG_FNTBLUE +

"${a}" + TAG_EFONT

If (Regex.IsMatch(sOutput, sSearchExpression)) Then

sOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)

End If

Return sOutput

End Function

Private Function IsScriptBlockTagStart(ByVal sInputLine As String) As Boolean

Dim bReturn As Boolean = False

If Regex.IsMatch(sInputLine, "<script.*runat=""?server""?.*>") Then

bReturn =

True

ElseIf Regex.IsMatch(sInputLine, "(?i)<%@\s*WebService") Then

bReturn =

True

End If

Return bReturn

End Function

Private Function IsScriptBlockTagEnd(ByVal sInputLine As String) As Boolean

Dim bReturn As Boolean = False

If (Regex.IsMatch(sInputLine, "</script.*>")) Then

bReturn =

True

End If

Return bReturn

End Function

Private Function IsMultiLineTagStart(ByVal sInputLine As String) As Boolean

Dim bReturn As Boolean = False

Dim sOutput As String

Dim sSearchExpression As String = "(?i)(?!.*&gt;)(?<a>&lt;/?)(?<b>(asp:|template|property|IBuySpy:).*)"

sOutput = HttpUtility.HtmlEncode(sInputLine)

If Regex.IsMatch(sOutput, sSearchExpression) Then

bReturn =

True

End If

Return bReturn

End Function

Private Function IsMultiLineTagEnd(ByVal sInputLine As String) As Boolean

Dim bReturn As Boolean = False

Dim sOutput As String

Dim sSearchExpression As String = "(?i)&gt;"

sOutput = HttpUtility.HtmlEncode(sInputLine)

If Regex.IsMatch(sOutput, sSearchExpression) Then

bReturn =

True

End If

Return bReturn

End Function

Private Class ProgrammingLanguage

Public Const VB As String = "vb"

Public Const CSharp As String = "c#"

Public Const JSharp As String = "js"

End Class

End

Class