Vad är det för fel på följande kod? Den skall ändra färg på nyckelorden och kommentarerna.
<code>
<pre id="vbCode">
'Comment
Sub Main()
vbCode.innerHTML = FormatCode(vbCode.innerHTML)
End Sub
</pre>
<script language="vbscript">

Keywords = "As Binary ByRef ByVal Date Else Empty Error False For Friend Get Input Is Len Let Lock Me Mid New Next Nothing Null On Option Optional ParamArray Print Private Property Public Resume Seek Set Static Step String Then Time To True WithEvents"
KeywordCount = Count(Keywords," ")
KeywordArr = Split(Keywords)
KeywordColor = "#000080"
CommentColor = "#008000"

KeywordStart = "<font color=" & chr(34) & KeywordColor & chr(34) & ">"
KeywordEnd = "</font>"

CommentStart = "<font color=" & chr(34) & CommentColor & chr(34) & ">"
CommentEnd = "</font>"

Function FormatCode(txt)
dim istr
istr = false
icomment = false
iKeyword = false
tmp = txt
tmp2 = "<textarea cols=50 rows=20>"
for i = 1 to len(tmp)
if skip <= 0 then
if iKeyword then
tmp2 = tmp2 & KeywordEnd
iKeyword = false
end if
select case ucase(mid(tmp,i,1))
case chr(34)
istr = not istr
tmp2 = tmp2 & mid(tmp,i,1)
case chr(13)
istr = false
skip = 1 'chr(10)
if iComment then
tmp2 = tmp2 & CommentEnd
end if
tmp2 = tmp2 & mid(tmp,i,1)
case "'"
if not istr then
icomment = true
skip = instr(i,tmp,chr(13)) - i - 1 'To end of line
end if
tmp2 = tmp2 & CommentStart & mid(tmp,i,1)
case else
for j = 0 to KeywordCount - 1
if mid(tmp,i,len(KeywordArr(j)))=KeywordArr(j) then
tmp2 = tmp2 & KeywordStart
iKeyword = true
Skip = Len(KeywordArr(j))
end if
next 'j
end select
else
skip = skip - 1
tmp2 = tmp2 & mid(tmp,i,1)
end if
next 'i
FormatCode = tmp2 & "

Jag vill inte vara otrevlig, men du skriver ganska klumpig och ful kod. Inga deklarationer, inga talande variabelnamn. Det blir så otroligt svårt för någon annan att förstå koden då.

Jag gjorde några små förbättringar (keywords kan inte börja mitt i ett comment, till exempel).
Min version av funktionen med mera blev så här:
<code>
Option Explicit
Dim Keywords As String
Dim KeywordCount As Integer
Dim KeywordArr As Variant
Dim KeywordColor As String
Dim CommentColor As String
Dim KeywordStart As String
Dim KeywordEnd As String
Dim CommentStart As String
Dim CommentEnd As String

Private Sub Form_Load()

Keywords = "As Binary ByRef ByVal Date Dim Else Empty Error False For Friend Get Input Integer Is Len Let Lock Me Mid New Next Nothing Null On Option Optional ParamArray Print Private Property Public Resume Seek Set Static Step String Then Time To True WithEvents"
KeywordArr = Split(Keywords, " ")
KeywordCount = UBound(KeywordArr)
KeywordColor = "#000080"
CommentColor = "#008000"

KeywordStart = "<font color=" & Chr(34) & KeywordColor & Chr(34) & ">"
KeywordEnd = "</font>"

CommentStart = "<font color=" & Chr(34) & CommentColor & Chr(34) & ">"
Option Explicit
Dim Keywords As String
Dim KeywordCount As Integer
Dim KeywordArr() As String
Dim KeywordColor As String
Dim CommentColor As String
Dim KeywordStart As String
Dim KeywordEnd As String
Dim CommentStart As String
Dim CommentEnd As String

Private Sub Form_Load()

Keywords = "As Binary ByRef ByVal Date Dim Else Empty Error False For Friend Get Input Integer Is Len Let Lock Me Mid New Next Nothing Null On Option Optional ParamArray Print Private Property Public Resume Seek Set Static Step String Then Time To True WithEvents"
KeywordArr = Split(Keywords, " ")
KeywordCount = UBound(KeywordArr)
KeywordColor = "#000080"
CommentColor = "#008000"

KeywordStart = "<font color=""" & KeywordColor & """>"
KeywordEnd = "</font>"

CommentStart = "<font color=""" & CommentColor & """>"
CommentEnd = "</font>"

Dim s As String
s = "Dim s As String 'En Variabel" & vbCrLf & _
"s = ""tourette's - by Nirvana"" 'A short " & """music""" & " String"
s = FormatCode(s)
Print s

End Sub

Function FormatCode(Text As String) As String
Dim bStr As Boolean, bComment As Boolean, bKeyword As Boolean
Dim iPos As Integer, iSkip As Integer, iKeyword As Integer
Dim sChar As String * 1


bStr = False
bComment = False
bKeyword = False
FormatCode = "<textarea cols=50 rows=20>"
For iPos = 1 To Len(Text)
If iSkip Then
FormatCode = FormatCode & Mid$(Text, iPos, iSkip)
iPos = iPos + iSkip
iSkip = 0
Else
sChar = Mid$(Text, iPos, 1)
If bKeyword Then
FormatCode = FormatCode & KeywordEnd
bKeyword = False
End If
Select Case sChar
Case Chr(34)
If Not bComment Then bStr = Not bStr
Case Chr(13)
bStr = False
If bComment Then
FormatCode = FormatCode & CommentEnd
bComment = False
End If
Case "'"
If Not bStr Then
bComment = True
FormatCode = FormatCode & CommentStart
End If
Case Else
If Not (bStr Or bComment) Then
For iKeyword = 0 To KeywordCount - 1
If Mid(Text, iPos, Len(KeywordArr(iKeyword))) = KeywordArr(iKeyword) Then
FormatCode = FormatCode & KeywordStart
bKeyword = True
iSkip = Len(KeywordArr(iKeyword)) - 1
End If
Next iKeyword
End If
End Select
FormatCode = FormatCode & sChar
End If
Next iPos
If bComment Then FormatCode = FormatCode & CommentEnd
End Function
</code>

Hoppas det hjälpte!

/Niklas Jansson