1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
| 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
|
