From DotNetJunkie XL on the 7th Floor
Option
Explicit OnImports
SystemImports
System.WebImports
System.TextImports
System.Text.RegularExpressionsPublic
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 errorSetLanguageFromFileName(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 sizeMyStringWriter.WriteLine(
"<font size=""" & _FontSize & """ \>") ' Process the language Select Case _Language.Trim.ToLower() Case ProgrammingLanguage.CSharpMyStringWriter.WriteLine(
"<pre>") For Each sInputLine In InputLinesMyStringWriter.Write(FixCSLine(sInputLine))
NextMyStringWriter.WriteLine(
"</pre>") Case ProgrammingLanguage.JSharpMyStringWriter.WriteLine(
"<pre>") For Each sInputLine In InputLinesMyStringWriter.Write(FixJSLine(sInputLine))
NextMyStringWriter.WriteLine(
"</pre>") Case ProgrammingLanguage.VBMyStringWriter.WriteLine(
"<pre>") For Each sInputLine In InputLinesMyStringWriter.Write(FixVBLine(sInputLine))
NextMyStringWriter.WriteLine(
"</pre>") Case Else Dim bIsInScriptBlock As Boolean = False Dim bIsInMultiLine As Boolean = FalseMyStringWriter.WriteLine(
"<pre>") For Each sInputLine In InputLines ' get the global language from a page directive_Language = GetLanguageFromLine(sInputLine, _Language)
If IsScriptBlockTagStart(sInputLine) ThenMyStringWriter.Write(FixASPXLine(sInputLine))
bIsInScriptBlock =
True ElseIf IsScriptBlockTagEnd(sInputLine) ThenMyStringWriter.Write(FixASPXLine(sInputLine))
bIsInScriptBlock =
False ElseIf IsMultiLineTagStart(sInputLine) And bIsInMultiLine = False ThenMyStringWriter.Write(
"<font color=blue><b>" + HttpUtility.HtmlEncode(sInputLine))bIsInMultiLine =
True ElseIf IsMultiLineTagEnd(sInputLine) And bIsInMultiLine = True ThenMyStringWriter.Write(HttpUtility.HtmlEncode(sInputLine) +
"</b></font>")bIsInMultiLine =
False ElseIf bIsInMultiLine ThenMyStringWriter.Write(HttpUtility.HtmlEncode(sInputLine))
Else If bIsInScriptBlock Then Select Case _Language.Trim.ToLower() Case ProgrammingLanguage.CSharpMyStringWriter.Write(FixCSLine(sInputLine))
Case ProgrammingLanguage.JSharpMyStringWriter.Write(FixJSLine(sInputLine))
Case ProgrammingLanguage.VBMyStringWriter.Write(FixVBLine(sInputLine))
Case ElseMyStringWriter.Write(FixVBLine(sInputLine))
End Select ElseMyStringWriter.Write(FixASPXLine(sInputLine))
End If End If NextMyStringWriter.WriteLine(
"</pre>") 'aspx-page sorted out End SelectMyStringWriter.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 ThensReturn = LanguageMatch.Groups(
"lang").ToString() End IfLanguageMatch = RegularExpressions.Regex.Match(sInputLine,
"(?i)(?=.*runat\s*=\s*""?server""?)<script.*language\s*=\s*""(?<lang>[^""]+)"".*>") If LanguageMatch.Success ThensReturn = LanguageMatch.Groups(
"lang").ToString() End IfLanguageMatch = RegularExpressions.Regex.Match(sInputLine,
"(?i)<%@\s*WebService\s*.*Language\s*=\s*""?(?<lang>[^""]+)""?") If LanguageMatch.Success ThensReturn = LanguageMatch.Groups(
"lang").ToString() End If ' "CS" instead of "C#" ? If sReturn = "CS" ThensReturn = 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 IfsOutput = 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 IfsOutput = 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 IfsOutput = 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>'(?![^']*").*$)", 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 spacessOutput = Regex.Replace(sOutput,
"(?i)(\t)", " ")sOutput = HttpUtility.HtmlEncode(sOutput)
' Single line comment or #include references.sSearchExpression =
"(?i)(?<a>(^.*))(?<b>(<!--))(?<c>(.*))(?<d>(-->))(?<e>(.*))"sReplaceExpression =
"${a}" & TAG_FNTGRN & "${b}${c}${d}" & TAG_EFONT & "${e}" If Regex.IsMatch(sOutput, sSearchExpression) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colorize <%@ <type>sSearchExpression =
"(?i)" + "(?<a>(<%@))" + "(?<b>(.*))" + "(?<c>(%>))"sReplaceExpression =
"<font color=blue><b>${a}${b}${c}</b></font>" If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colorize <%# <type>sSearchExpression =
"(?i)" + "(?<a>(<%#))" + "(?<b>(.*))" + "(?<c>(%>))"sReplaceExpression =
"${a}" + "<font color=red><b>" + "${b}" + "</b></font>" + "${c}" If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colorize tag <type>sSearchExpression =
"(?i)" + "(?<a>(<)(?!%)(?!/?asp:)(?!/?template)(?!/?property)(?!/?ibuyspy:)(/|!)?)" + "(?<b>[^;\s&]+)" + "(?<c>(\s|>|\Z))"sReplaceExpression =
"${a}" + TAG_FNTMRN + "${b}" + TAG_EFONT + "${c}" If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colorize asp:|template for runat=server tags <type>sSearchExpression =
"(?i)(?<a></?)(?<b>(asp:|template|property|IBuySpy:).*)(?<c>>)?"sReplaceExpression =
"${a}" + TAG_FNTBLUE + "<b>${b}</b>" + TAG_EFONT + "${c}" If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colourise begin of tag char(s) "<","</","<%"sSearchExpression =
"(?i)(?<a>(<)(/|!|%)?)"sReplaceExpression = TAG_FNTBLUE +
"${a}" + TAG_EFONT If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = Regex.Replace(sOutput, sSearchExpression, sReplaceExpression)
End If ' Colorize end of tag char(s) ">","/>"sSearchExpression =
"(?i)(?<a>(/|%)?(>))"sReplaceExpression = TAG_FNTBLUE +
"${a}" + TAG_EFONT If (Regex.IsMatch(sOutput, sSearchExpression)) ThensOutput = 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""?.*>") ThenbReturn =
True ElseIf Regex.IsMatch(sInputLine, "(?i)<%@\s*WebService") ThenbReturn =
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.*>")) ThenbReturn =
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)(?!.*>)(?<a></?)(?<b>(asp:|template|property|IBuySpy:).*)"sOutput = HttpUtility.HtmlEncode(sInputLine)
If Regex.IsMatch(sOutput, sSearchExpression) ThenbReturn =
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)>"sOutput = HttpUtility.HtmlEncode(sInputLine)
If Regex.IsMatch(sOutput, sSearchExpression) ThenbReturn =
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 ClassEnd
Class