Imports Microsoft.VisualBasic
Imports System.Xml
Public Class CodeFormatter
Private xVBScript As XmlDocument
Private xTSQL As XmlDocument
Public Enum enumCodeType
VBScript = 1
BAT = 2
KiXtart = 3
PowerShell = 4
HTA = 5
General = 0
TSQL = 6
End Enum
Public Function FormatCode(ByVal code As String, ByVal codeType As enumCodeType, ByVal useAlt As Boolean, ByVal lineNos As Boolean) As String
' code = code.Replace("<", "<")
' code = code.Replace(">", ">")
Dim formattedCode As String
Select Case codeType
Case enumCodeType.VBScript
formattedCode = formatVBScript(code, useAlt, lineNos)
Case enumCodeType.BAT
formattedCode = formatBatchFile(code, useAlt, lineNos)
Case enumCodeType.PowerShell
formattedCode = formatPowerShell(code, useAlt, lineNos)
Case enumCodeType.TSQL
formattedCode = formatTSQL(code, useAlt, lineNos)
Case enumCodeType.HTA
formattedCode = formatHTA(code, useAlt, lineNos)
Case Else
formattedCode = formatOther(code, useAlt, lineNos)
End Select
If lineNos Then
Return "<div class=""CodeFormatter""><ol>" & formattedCode & "</ol></div>"
Else
Return "<div class=""CodeFormatter""><pre>" & formattedCode & "</pre></div>"
End If
End Function
#Region "TSQL"
Private Function formatTSQL(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean, Optional ByVal alt As Boolean = False) As String
Dim sb As New System.Text.StringBuilder
Dim sbBuffer As New System.Text.StringBuilder
Dim isComment As Boolean, isCommentBlock As Boolean
Dim commentBlockCount As Int32 = 0
Dim isDoubleQuote As Boolean
Dim isQuote As Boolean
Dim lastChar As String = ""
Dim nextChar As String
If lineNos Then
If useAlt = True And alt Then
sb.Append("<li class=""alt"">")
Else
sb.Append("<li>")
End If
alt = Not alt
End If
Dim rdr As New IO.StringReader(code)
While rdr.Peek <> -1
Dim thisChar As String = Convert.ToChar(rdr.Read)
If rdr.Peek <> -1 Then
nextChar = Convert.ToChar(rdr.Peek)
Else
nextChar = ""
End If
If thisChar = Chr(13) Or thisChar = Chr(10) Then
If isCommentBlock Then
sb.Append(formatComment(sbBuffer.ToString))
ElseIf isQuote Then
sb.Append(formatQuoted2(sbBuffer.ToString))
ElseIf isDoubleQuote Then
sb.Append(sbBuffer.ToString)
Else
sb.Append(formatTSQLKeyword(sbBuffer.ToString))
End If
If lineNos = True Then
If useAlt = True And alt = True Then
sb.Append("</li><li class=""alt"">")
Else
sb.Append("</li><li>")
End If
Else
sb.AppendLine()
End If
sbBuffer = New System.Text.StringBuilder
If nextChar = Chr(10) Then
rdr.Read()
End If
alt = Not alt
Else
sbBuffer.Append(thisChar)
End If
If isComment Then
If nextChar = Chr(13) Or nextChar = Chr(10) Then
sb.Append(formatComment(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
isComment = False
End If
ElseIf isCommentBlock Then
If lastChar = "*" AndAlso thisChar = "/" Then
commentBlockCount -= 1
End If
If thisChar = "/" AndAlso nextChar = "*" Then
commentBlockCount += 1
End If
If commentBlockCount = 0 Then
sb.Append(formatComment(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
isCommentBlock = False
End If
ElseIf isQuote Then
If thisChar = "'" Then
sb.Append(formatQuoted2(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
isQuote = False
End If
ElseIf isDoubleQuote Then
If thisChar = """" Then
sb.Append(HttpUtility.HtmlEncode(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
isDoubleQuote = False
End If
Else
If thisChar = "'" Then
isQuote = True
ElseIf thisChar = """" Then
sb.Append(HttpUtility.HtmlEncode(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
isDoubleQuote = True
ElseIf thisChar = "/" And nextChar = "*" Then
isCommentBlock = True
commentBlockCount = 1
ElseIf thisChar = "-" And nextChar = "-" Then
isComment = True
ElseIf Char.IsLetterOrDigit(thisChar) = False And thisChar <> "@" And thisChar <> "_" And thisChar <> "#" Then
sb.Append(HttpUtility.HtmlEncode(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
Else
If Char.IsLetterOrDigit(nextChar) = False And nextChar <> "_" And nextChar <> "@" Then
sb.Append(formatTSQLKeyword(sbBuffer.ToString))
sbBuffer = New System.Text.StringBuilder
End If
End If
End If
lastChar = thisChar
End While
If lineNos Then
sb.Append("</li>")
End If
sb.Append(HttpUtility.HtmlEncode(sbBuffer.ToString))
Return sb.ToString
End Function
Private Function formatTSQLKeyword(ByVal word As String) As String
If xTSQL Is Nothing Then
xTSQL = New XmlDocument
xTSQL.Load(System.Web.HttpContext.Current.Request.PhysicalApplicationPath & "App_Data\tsql.xml")
End If
If word.IndexOf("""") > 0 Then
Return HttpUtility.HtmlEncode(word)
End If
Dim n As XmlNode
n = xTSQL.SelectSingleNode("/tsql/keyword[@value=""" & word.ToUpper & """]")
If n Is Nothing Then
Return word
Else
Return "<span class=""" & n.Attributes("class").Value & """>" & HttpUtility.HtmlEncode(word) & "</span>"
End If
End Function
#End Region
Private Function formatHTA(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean) As String
Dim sb As New System.Text.StringBuilder
Dim startIdx As Int32 = 0
Dim alt As Boolean = False
Do
Dim iStartTag As Int32, iEndTag As Int32
Dim iEndElement As Int32
Dim scriptTag As String
iStartTag = code.IndexOf("<script ", startIdx)
If iStartTag >= 0 Then
iEndTag = code.IndexOf(">", iStartTag)
If iEndTag >= 0 Then
iEndElement = code.IndexOf("</script>", iEndTag)
Else
Exit Do
End If
Else
Exit Do
End If
scriptTag = code.Substring(iStartTag, iEndTag - iStartTag + 1)
If scriptTag.ToLower.IndexOf("vbscript") >= 0 Then
sb.Append(formatOther(code.Substring(0, iEndTag + 1), useAlt, lineNos, alt))
sb.Append(formatVBScript(code.Substring(iEndTag + 1, iEndElement - iEndTag - 1), useAlt, lineNos, alt))
code = code.Substring(iEndElement)
Else
startIdx = iEndElement
End If
Loop
sb.Append(formatOther(code, useAlt, lineNos, alt))
Return sb.ToString
End Function
Private Function formatPowerShell(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean) As String
Dim sb As New Text.StringBuilder
Dim rdr As New IO.StringReader(code)
Dim i As Int32 = 0
While rdr.Peek <> -1
Dim line As String = rdr.ReadLine
If lineNos = True Then
If i Mod 2 = 0 And useAlt = True Then
sb.Append("<li class=""alt"">")
Else
sb.Append("<li>")
End If
End If
If line.StartsWith("#") Then
sb.Append(formatComment(line))
Else
If line.IndexOf(" #") > 0 Then
sb.Append(HttpUtility.HtmlEncode(line.Substring(0, line.IndexOf(" #"))))
sb.Append(formatComment(line.Substring(line.IndexOf(" #"), Len(line) - line.IndexOf(" #"))))
Else
sb.Append(HttpUtility.HtmlEncode(line))
End If
End If
If lineNos Then
sb.Append("</li>")
Else
sb.AppendLine()
End If
i += 1
End While
Return sb.ToString
' Return "<div class=""code""><pre>" & sb.ToString & "</pre></div>"
End Function
Private Function formatBatchFile(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean) As String
Dim sb As New Text.StringBuilder
Dim rdr As New IO.StringReader(code)
Dim i As Int32 = 0
While rdr.Peek <> -1
Dim line As String = rdr.ReadLine
If lineNos = True Then
If i Mod 2 = 0 And useAlt = True Then
sb.Append("<li class=""alt"">")
Else
sb.Append("<li>")
End If
End If
If line.ToLower.StartsWith("rem ") Or line.ToLower = "rem" Or line.StartsWith("::") Then
sb.Append(formatComment(line))
Else
sb.Append(HttpUtility.HtmlEncode(line))
End If
If lineNos Then
sb.Append("</li>")
Else
sb.AppendLine()
End If
i += 1
End While
Return sb.ToString
End Function
Private Function formatOther(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean, Optional ByRef alt As Boolean = False) As String
Dim sb As New Text.StringBuilder
Dim rdr As New IO.StringReader(code)
While rdr.Peek <> -1
Dim line As String = rdr.ReadLine
If lineNos = True Then
If alt And useAlt = True Then
sb.Append("<li class=""alt"">")
Else
sb.Append("<li>")
End If
End If
sb.Append(HttpUtility.HtmlEncode(line))
If lineNos Then
sb.Append("</li>")
Else
sb.AppendLine()
End If
alt = Not alt
End While
Return sb.ToString
End Function
Private Function formatVBScript(ByVal code As String, ByVal useAlt As Boolean, ByVal lineNos As Boolean, Optional ByRef alt As Boolean = False) As String
' Dim sb As New System.Text.StringBuilder
Dim sbFormatted As New System.Text.StringBuilder
Dim thisChar As Char, nextChar As Char, word As String = ""
'Dim formattedCode As String = ""
Dim openDoubleQuote As Boolean, beginComment As Boolean
Dim rdr As New System.IO.StringReader(code)
If lineNos Then
If useAlt And alt Then
sbFormatted.Append("<li class=""alt"">")
Else
sbFormatted.Append("<li>")
End If
alt = Not alt
End If
While rdr.Peek <> -1
thisChar = Convert.ToChar(rdr.Read)
If rdr.Peek <> -1 Then
nextChar = Convert.ToChar(rdr.Peek)
Else
nextChar = ""
End If
If thisChar = """" And beginComment = False Then 'Quoted string not inside comment
If openDoubleQuote Then 'End of Quoted string
sbFormatted.Append(formatQuoted(word & thisChar))
word = ""
Else 'Start of quoted string
sbFormatted.Append(HttpUtility.HtmlEncode(word))
word = thisChar
End If
openDoubleQuote = Not openDoubleQuote
ElseIf thisChar = "'" And openDoubleQuote = False And beginComment = False Then ' Start of comment
sbFormatted.Append(HttpUtility.HtmlEncode(word))
beginComment = True
word = thisChar
' ElseIf thisChar = Chr(13) And beginComment = True Then 'End of comment (new line)
' sbFormatted.Append(formatComment(word) & thisChar)
' word = ""
' beginComment = False
Else
If thisChar = Chr(13) Or thisChar = Chr(10) Then
If beginComment Then
sbFormatted.Append(formatComment(word))
beginComment = False
ElseIf openDoubleQuote Then
sbFormatted.Append(formatQuoted(word))
Else
If isKeyWord(word) Then
sbFormatted.Append(formatKeyWord(word))
ElseIf word.ToLower = "rem" Then
sbFormatted.Append(formatComment(word))
Else
sbFormatted.Append(HttpUtility.HtmlEncode(word))
End If
End If
If lineNos = True Then
If alt And useAlt = True Then
sbFormatted.Append("</li><li class=""alt"">")
Else
sbFormatted.Append("</li><li>")
End If
Else
sbFormatted.AppendLine() '("<br/>")
End If
word = ""
If nextChar = Chr(10) Or nextChar = Chr(13) Then
rdr.Read()
End If
alt = Not alt
ElseIf (Char.IsWhiteSpace(thisChar) Or Char.IsPunctuation(thisChar)) _
And openDoubleQuote = False And beginComment = False And thisChar <> "_" Then
'White space or punctuation ends the current word unless inside quotation or comment
If word.ToLower = "rem" And thisChar = Chr(13) Then 'rem on line by itself
word = formatComment(word) & thisChar
sbFormatted.Append(word)
word = ""
ElseIf word.ToLower = "rem" Then 'start of comment
word &= thisChar
beginComment = True
Else
If isKeyWord(word) Then
word = formatKeyWord(word)
Else
word = HttpUtility.HtmlEncode(word)
End If
sbFormatted.Append(word & HttpUtility.HtmlEncode(thisChar))
word = ""
End If
Else 'build word char by char
word &= thisChar
End If
End If
End While
' formatting of last word
If beginComment = True Then
sbFormatted.Append(formatComment(word))
ElseIf isKeyWord(word) Then
sbFormatted.Append(formatKeyWord(word))
Else
sbFormatted.Append(HttpUtility.HtmlEncode(word))
End If
If lineNos Then
sbFormatted.Append("</li>")
End If
Return sbFormatted.ToString
End Function
Private Function formatKeyWord(ByVal code As String) As String
Return "<span class=""CF_KW"">" & HttpUtility.HtmlEncode(code) & "</span>"
End Function
Private Function formatComment(ByVal code As String) As String
Return "<span class=""CF_C"">" & HttpUtility.HtmlEncode(code) & "</span>"
End Function
Private Function formatQuoted(ByVal code As String) As String
Return "<span class=""CF_Q"">" & HttpUtility.HtmlEncode(code) & "</span>"
End Function
Private Function formatQuoted2(ByVal code As String) As String
Return "<span class=""CF_Q2"">" & HttpUtility.HtmlEncode(code) & "</span>"
End Function
Function isKeyWord(ByVal word As String) As Boolean
word = word.ToLower
If xVBScript Is Nothing Then
xVBScript = New XmlDocument
xVBScript.Load(System.Web.HttpContext.Current.Request.PhysicalApplicationPath & "App_Data\vbscript.xml")
End If
Dim n As XmlNode
n = xVBScript.SelectSingleNode("/vbscript//add[@key=""" & word & """]")
If n Is Nothing Then
Return False
Else
Return True
End If
End Function
End Class
