Uses "FILE" ' needed to load keywords...
Uses "CONSOLE" ' for demonstration-purpose
'[] top of script
Begin Const
%await_NONE
%await_EndFunction
%await_EndSub
%await_EndWith
%await_EndType
%await_EndUnion
%await_DPlusENDIF ' = "#ENDIF"
%await_EndIf
%await_Case
%await_EndSelect
%await_Next
%await_Wend
%await_Loop
%await_Until
End Const
Dim sKeyword() As String ' array of tB-keywords
Dim sCodeLine() As String ' read-in codelines (change by check in memory)
Dim sErrors As String
Dim sExpression() As String ' store expressions
Dim lExpression() As Long ' line of expression
Dim nExpressions As Long
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Function TBMain()
' change sFile to any you want...
Local sFile As String = APP_Path + "SampleScripts\General\ByRef\Byref_Array_UDT.tBasic"
Local myErrorReport As String = SpellCheck_Proceed(FILE_Load(sFile))
If StrPtrLen(StrPtr(myErrorReport)) Then
Local sOut() As String
Local nLines, i As Long
nLines = Parse( myErrorReport, sOut, $CRLF)
PrintL "found " + Str$(nLines - 1) + " messages:"
PrintL
For i = 1 To nLines - 1
PrintL "Line-Number " + Val("&H" + Peek$(StrPtr(sOut(i)), 8)) + " reports:"
PrintL Peek$(StrPtr(sOut(i)) + 8, StrPtrLen(StrPtr(sOut(i))) - 8 )
PrintL
Next
If Val("&H" + Peek$(StrPtr(sOut(nLines)), 8)) = -1 Then
PrintL "Check aborted because of script-structure-problem"
Else
PrintL "Check finished"
EndIf
Else
PrintL "No problems found"
EndIf
WaitKey
End Function
' ------------------------------------------------------------------------------
Function SpellCheck_Proceed(ByVal sScript As String) As String
' pass some tB-Script and receive Error-String delimited by $CRLF
' if no errors found returns empty string
' every single error-textline starts with 8 Bytes Hex$ of the scriptline-number
' (these bytes are represented here in comment-text as "§")
' somewhat like "§§§§§§§§ErrorTextHere" + $crlf
' at the end get 8 Bytes more appended -only if any error found at all-
' and mean
' -1 check has been stopped through script-structure-problem
' 0 check ran through until end
' two errors would look now like this
' "§§§§§§§§ErrorText1" + $crlf + "§§§§§§§§ErrorText2" + $crlf + Hex$(a 0 or -1 here, 8)
' first get keywords...
If Not FILE_Exists(APP_Path + "thinAir\Syntax\thinBasic\thinBasic_Keywords.ini") Then
MsgBox(0, "Can not find thinBasic_Keywords.ini", %MB_OK , "Unable to run")
Return ""
EndIf
Local lKeywords As String = Ucase$(FILE_Load(APP_Path + "thinAir\Syntax\thinBasic\thinBasic_Keywords.ini"))
If Not Parse(lKeywords, sKeyword, $CRLF) Then
MsgBox(0, "thinBasic_Keywords.ini seems to be corrupted", %MB_OK , "Unable to run")
Return ""
Endif
' parse the script to lines, all ucase$
ReDim sCodeLine(1)
sScript = Ucase$(sScript)
Local nLines As Long = Parse(sScript, sCodeline, $CRLF)
If nLines < 1 Then Return ""
Local cl, lLen As Long
' go through all lines, remove Rem etc. sort numerals out
' combine them to actual lines if line-continuation etc.
For cl = 1 To nLines
Check_Codelines(cl)
Next
' next step is checking "If/Elseif" followed by "Then"
' every "Sub" has an "End Sub" etc.
' looks quite confusing much here, but is not that wild...
For cl = 1 To nLines
lLen = StrPtrLen(StrPtr(sCodeline(cl)))
If lLen > 1 Then
If Peek$(StrPtr(sCodeline(cl)), 2) = "IF" Then
Check_Then(cl, "IF")
Else
If lLen > 2 Then
If Peek$(StrPtr(sCodeline(cl)), 3) = "SUB" Then
Check_End(cl, "SUB")
Else
If lLen > 3 Then
If Peek$(StrPtr(sCodeline(cl)), 4) = "WITH" Then
Check_End(cl, "WITH")
ElseIf Peek$(StrPtr(sCodeline(cl)), 4) = "TYPE" Then
Check_End(cl, "TYPE")
Else
If lLen > 4 Then
If Peek$(StrPtr(sCodeline(cl)), 5) = "UNION" Then
Check_End(cl, "UNION")
Else
If lLen > 5 Then
If Peek$(StrPtr(sCodeline(cl)), 6) = "ELSEIF" Then
Check_Then(cl, "ELSEIF")
ElseIf Peek$(StrPtr(sCodeline(cl)), 6) = "SELECT" Then
If lLen >= 11 Then
If Peek$(StrPtr(sCodeline(cl)), 11) <> "SELECT CASE" Then sErrors += Hex$(cl, 8) + "SELECT missing: CASE" + $CRLF
Else
sErrors += Hex$(cl, 8) + "SELECT missing: CASE" + $CRLF
EndIf
Else
If lLen > 7 Then
If Peek$(StrPtr(sCodeline(cl)), 8) = "FUNCTION" Then
Check_End(cl, "FUNCTION")
Else
If lLen >= 11 Then
If Peek$(StrPtr(sCodeline(cl)), 11) = "BEGIN CONST" Then
If lLen = 11 Then sCodeLine(cl) += " "
Check_End(cl, "CONST")
sCodeLine(cl) = TrimFull$(sCodeline(cl))
Else
If lLen >= 15 Then
If Peek$(StrPtr(sCodeline(cl)), 15) = "BEGIN CONTROLID" Then
If lLen = 15 Then sCodeLine(cl) += " "
Check_End(cl, "CONTROLID")
sCodeLine(cl) = TrimFull$(sCodeline(cl))
Else
If lLen > 16 Then
If Peek$(StrPtr(sCodeline(cl)), 17) = "CALLBACK FUNCTION" Then
Check_End(cl, "FUNCTION")
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
Next
' now check nesting-levels, sort out known keywords, binary (&B) and hex (&H)
For cl = 1 To nLines
If StrPtrLen(StrPtr(sCodeline(cl))) > 1 Then
If Not Check_Loops(cl) Then
' structural problem, makes no sense further checking
sErrors += Hex$(-1, 8)
Return sErrors
EndIf
EndIf
Next
' now check all collected unknown expressions
' if the long lExpression(x) = 0 then this
' sExpression(x) has been found more than once already
If nExpressions Then
For cl = 1 To nExpressions
If lExpression(cl) <> 0 Then sErrors += Hex$(lExpression(cl),8) + "dubious expression: " + sExpression(cl) + $CRLF
Next
EndIf
If StrPtrLen(StrPtr(sErrors)) Then sErrors += Hex$(0, 8)
Return sErrors
End Function
' ------------------------------------------------------------------------------
Sub Check_Codelines(ByVal atLine As Long)
Static i, nChars, lParenthesis, lStart As Long
Static bChar, bSpace As Byte
Static sBuffer As String
Static inQuote, bContinueRemark, bContinueLine As Boolean
sCodeLine(atLine) = TrimFull$(sCodeLine(atLine))
If StrPtrLen(StrPtr(sCodeLine(atLine))) < 1 Then
bContinueLine = FALSE
lStart = 0
Exit Sub
EndIf
bSpace = 1
inQuote = FALSE
sBuffer = String$(StrPtrLen(sCodeLine(atLine)), 32)
nChars = 0
If Not lStart Then lStart = atLine
For i = 1 To StrPtrLen(StrPtr(sCodeline(atLine)))
bChar = Peek(StrPtr(sCodeLine(atLine)) + i - 1)
If bContinueRemark Then
If bChar = 43 Then ' */
If i < StrPtrLen(StrPtr(sCodeline(atLine))) Then
If Peek(StrPtr(sCodeline(atLine)) + i) = 47 Then bContinueRemark = FALSE
EndIf
EndIf
Else
If bChar = 34 Then inQuote = inQuote XOR TRUE
If Not inQuote Then
If Not bSpace Then bContinueLine = FALSE
Select Case bChar
Case 32
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 34
Case 38 ' &
If i < StrPtrLen(StrPtr(sCodeLine(atLine))) Then
Select Case Peek(StrPtr(sCodeline(atLine))+i)
Case 66, 72 ' &B, &H
Poke(StrPtr(sBuffer) + nChars, 38)
nChars += 1
bSpace = 0
End Select
EndIf
Case 39 ' '
Exit For
Case 40 ' (
lParenthesis += 1
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 41 ' )
lParenthesis -= 1
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 42 To 46 ' * + , - .
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 47 ' /*
If i < StrPtrLen(StrPtr(sCodeline(atLine))) Then
If Peek(StrPtr(sCodeline(atLine)) + i) = 43 Then
bContinueRemark = TRUE
EndIf
EndIf
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars + 1
bSpace = 1
EndIf
Case 48 To 57 ' 0 to 9
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
EndIf
Case 58 To 60 ' : ; <
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 61 ' =
If nChars >= 8 + bSpace Then
If Peek$(StrPtr(sBuffer) + nChars - 8 - bSpace, 8) = "FUNCTION" Then
' remove "Function ="
If nChars = 8 + bSpace Then
sBuffer = ""
nChars = 0
Else
If Peek(StrPtr(sBuffer) + nChars - 9 - bSpace) = 32 Then
nChars -= 8 + bSpace
sBuffer = Peek$(StrPtr(sBuffer), nChars)
EndIf
EndIf
Else
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
EndIf
Else
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
EndIf
Case 62, 92 ' > \
If bSpace = 0 Then
Poke(StrPtr(sBuffer) + nChars, 32)
nChars += 1
bSpace = 1
EndIf
Case 73 ' I - combine "End" + "If" to "EndIf"
If i < StrPtrLen(StrPtr(sCodeline(atLine))) And bSpace = 1 And nChars >= 4 And TRUE Then
If Peek(StrPtr(sCodeline(atLine)) + i ) = 70 Then 'F
If nChars = 4 Then
If Peek$(StrPtr(sBuffer), 4) = "END " Then nChars -= 1
Else
If Peek$(StrPtr(sBuffer) + nChars - 5, 5) = " END " Then
nChars -= 1
EndIf
EndIf
EndIf
EndIf
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
Case 82 ' R (REM)
if bSpace then
If i + 2 <= StrPtrLen(StrPtr(sCodeline(atLine))) Then
If Peek(StrPtr(sCodeline(atLine)) + i) = 69 Then
If Peek(StrPtr(sCodeline(atLine))+ i + 1) = 77 Then
If i + 2 = StrPtrLen(StrPtr(sCodeline(atLine))) Then Exit For
If Peek(StrPtr(sCodeline(atLine))+ i + 2) = 32 Then Exit For
EndIf
EndIf
EndIf
Endif
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
Case 95 ' _
If bSpace Then
If i = StrPtrLen(StrPtr(sCodeline(atLine))) Then
bContinueLine = TRUE
Else
If Peek(StrPtr(sCodeline(atLine)) + i) = 32 Then
bContinueLine = TRUE
Else
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
EndIf
EndIf
Else
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
EndIf
Case Else
Poke(StrPtr(sBuffer) + nChars, bChar)
nChars += 1
bSpace = 0
End Select
EndIf
EndIf
Next
If nChars Then
If lStart = atLine Then
sCodeLine(lStart) = TrimFull$(Peek$(StrPtr(sBuffer), nChars))
Else
sCodeLine(lStart) += " " + TrimFull$(Peek$(StrPtr(sBuffer), nChars))
sCodeline(atLine) = ""
EndIf
Else
sCodeLine(atLine) = ""
bContinueLine = FALSE
EndIf
If Not bContinueLine Then
If inQuote Then sErrors += Hex$(lStart, 8) + "Missing quotes" + $CRLF
If lParenthesis < 0 Then
sErrors += Hex$(lStart, 8) + "Parenthesis - missing (" + $CRLF
ElseIf lParenthesis > 0 Then
sErrors += Hex$(lStart, 8) + "Parenthesis - missing )" + $CRLF
EndIf
lParenthesis = 0
lStart = 0
EndIf
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub Check_Then(ByVal Start As Long, ByVal Keyword As String)
Local sArg() As String
Static i, j, nArgs As Long
If StrPtrLen(StrPtr(sCodeline(Start))) > StrPtrLen(StrPtr(Keyword)) Then
' not followed by a space is not the keyword we search for
If Peek(StrPtr(sCodeline(Start)) + StrPtrLen(StrPtr(Keyword))) <> 32 Then Exit Sub
EndIf
If StrPtrLen(StrPtr(sCodeline(Start))) < StrPtrLen(StrPtr(Keyword)) + 5 Then
sErrors += Hex$(Start, 8) + Keyword + " missing: THEN" + $CRLF
Exit Sub
EndIf
nArgs = Parse(sCodeline(Start), sArg, " ")
If nArgs < 2 Then
sErrors += Hex$(lStart, 8) + Keyword + " missing: THEN" + $CRLF
Exit Sub
EndIf
i = 0 : j = 0
Do
i = Array Scan sArg(1+i), Collate Ucase, = "THEN"
If i Then j += 1
Loop Until i = 0 Or i = nArgs
If Keyword = "IF" And sArg(nArgs) <> "THEN" And TRUE Then
'remove one-line if
sCodeline(Start) = ""
For i = 2 To nArgs
If sArg(i) <> "THEN" Then
If sArg(i) <> "ELSE" Then
If sArg(i) <> "ENDIF" Then
sCodeline(Start) += sArg(i)
If i < nArgs Then sCodeline(Start) += " "
EndIf
EndIf
EndIf
Next i
EndIf
If j < 1 Then
sErrors += Hex$(Start, 8) + Keyword + " missing: THEN" + $CRLF
ElseIf j > 1 Then
sErrors += Hex$(Start, 8) + Keyword + " redundant: THEN" + $CRLF
EndIf
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub Check_End(ByVal Start As Long, ByVal Keyword As String)
Static i, lsLen, lcLen As Long
Static sSearch As String
If StrPtrLen(StrPtr(sCodeline(Start))) > StrPtrLen(StrPtr(Keyword)) Then
' not followed by a space is not the keyword we search for
If Peek(StrPtr(sCodeline(Start)) + StrPtrLen(StrPtr(Keyword))) <> 32 Then Exit Sub
EndIf
If StrPtrLen(StrPtr(sCodeline(Start))) < StrPtrLen(StrPtr(Keyword)) + 2 Then
sErrors += Hex$(Start, 8) + Keyword + " missing: identity" + $CRLF
Exit Sub
EndIf
sSearch = "END " + Keyword
lsLen = StrPtrLen(StrPtr(sSearch))
For i = Start To UBound(sCodeline)
lcLen = StrPtrLen(StrPtr(sCodeline(i)))
If lcLen >= lsLen Then
If Peek$(StrPtr(sCodeline(i)) + lcLen - lsLen, lsLen) = sSearch Then Exit Sub
EndIf
If i > Start Then
If lcLen > 3 Then
If Peek$(StrPtr(sCodeline(i)), 4) = "SUB " Then Exit For
If lcLen > 8 Then
If Peek$(StrPtr(sCodeline(i)), 9) = "FUNCTION " Then Exit For
If lcLen > 17 Then
If Peek$(StrPtr(sCodeline(i)), 18) = "CALLBACK FUNCTION " Then Exit For
EndIf
EndIf
EndIf
EndIf
Next
sErrors += Hex$(Start, 8) + "missing: END " + Keyword + $CRLF
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function Check_Loops(ByVal Start As Long) As Boolean
Local sArg() As String
Static i, j, nArgs, lAwait As Long
Static lError, lFound As Long
Static bFound As Boolean
Static sAwait, sFound As String
If sAwait = "" Then sAwait = MKL$(%await_NONE)
' returns false if structural problem -
' unable to find the right loop then, has to stop checking
nArgs = Parse(sCodeline(Start), sArg, " ")
If nArgs < 1 Then Return TRUE
lError = 0
For i = 1 To nArgs
lAwait = Peek(Long, StrPtr(sAwait) + StrPtrLen(StrPtr(sAwait)) - SizeOf(Long))
Select Case sArg(i)
Case "EXIT"
If nArgs > i Then
Select Case sArg(i + 1)
Case "FOR", "DO", "WHILE", "SUB", "FUNCTION"
sArg(i + 1) = ""
End Select
EndIf
Case "#IF"
sAwait += MKL$(%await_DPlusENDIF)
Case "#ELSE", "#ELSEIF"
If lAwait <> %await_DPlusENDIF Then
sFound = sArg(i)
lError = 1
Exit For
EndIf
Case "#ENDIF"
If lAwait = %await_DPlusENDIF Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
sFound = sArg(i)
lError = 1
Exit For
EndIf
Case "END"
If nArgs > i Then
Select Case sArg(i + 1)
Case "SUB", "FUNCTION"
If lAwait = %await_EndSub Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
ElseIf lAwait = %await_EndFunction Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
Else
lError = 1
sFound = "END " + sArg(i + 1)
Exit For
EndIf
If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
Case "SELECT"
If lAwait = %await_EndSelect Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
Else
lError = 1
sFound = "END SELECT"
Exit For
EndIf
If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
Case "WITH"
If lAwait = %await_EndWith Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
Else
lError = 1
sFound = "END WITH"
Exit For
EndIf
If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
Case "TYPE"
If lAwait = %await_EndType Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
Else
lError = 1
sFound = "END TYPE"
Exit For
EndIf
If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
Case "UNION"
If lAwait = %await_EndUnion Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
sArg(i+1) = ""
Else
lError = 1
sFound = "END UNION"
Exit For
EndIf
If i + 1 < nArgs Then sErrors += Hex$(Start, 8) + "expected: End of Line" + $CRLF
End Select
Else
sErrors += Hex$(Start, 8) + "END missing: identifier" + $CRLF
EndIf
Case "IF"
If i < nArgs Then
For j = i + 1 To nArgs
If sArg(j) = "THEN" Then
If j = nArgs Then sAwait += MKL$(%await_EndIf)
Exit For
EndIf
Next j
EndIf
Case "ELSE", "ELSEIF"
If lAwait <> %await_EndIf Then
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "ENDIF"
If lAwait = %await_EndIf Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "SUB"
sAwait += MKL$(%await_EndSub)
Case "FUNCTION"
sAwait += MKL$(%await_EndFunction)
Case "CALLBACK"
If nArgs > 1 Then
If sArg(2) = "FUNCTION" Then
sAwait += MKL$(%await_EndFunction)
sArg(2) = ""
EndIf
EndIf
Case "DO"
sAwait += MKL$(%await_Loop)
If nArgs > i Then
Select Case sArg(i+1)
Case "WHILE", "UNTIL"
sArg(i+1) = ""
End Select
EndIf
Case "SELECT"
sAwait += MKL$(%await_Case)
If nArgs > i Then
If sArg(i+1) = "CASE" Then sArg(i+1) = ""
EndIf
Case "CASE"
If lAwait = %await_Case Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) ) + MKL$(%await_EndSelect)
ElseIf lAwait = %await_EndSelect Then
If nArgs > i Then
If sArg(i+1) = "ELSE" Then sArg(i+1) = ""
EndIf
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "LOOP"
If lAwait = %await_Loop Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
If nArgs > i Then
Select Case sArg(i+1)
Case "WHILE", "UNTIL"
sArg(i+1) = ""
End Select
EndIf
Case "WHILE"
sAwait += MKL$(%await_Wend)
Case "WEND"
If lAwait = %await_Wend Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "REPEAT"
sAwait += MKL$(%await_Until)
Case "UNTIL"
If lAwait = %await_Until Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "FOR"
lError = 300
If i >= 3 Then
For j = 1 To i - 1
If sArg(j) = "ARRAY" Then lError -= 210
If sArg(j) = "SCAN" Then lError -= 90
If lError = 0 Then Exit For
Next j
EndIf
Select Case lError
Case 0
' ignore array scan
Case 300
' for-next
sAwait += MKL$(%await_Next)
lError = 0
Case Else
sErrors += Hex$(Start, 8) + "ARRAY SCAN ?" + $CRLF
End Select
Case "NEXT"
If lAwait = %await_Next Then
sAwait = Peek$( StrPtr(sAwait), StrPtrLen(StrPtr(sAwait)) - SizeOf(Long) )
Else
lError = 1
sFound = sArg(i)
Exit For
EndIf
Case "WITH"
sAwait += MKL$(%await_EndWith)
Case "TYPE"
sAwait += MKL$(%await_EndType)
Case "UNION"
sAwait += MKL$(%await_EndUnion)
Case Else
' collect unknown expressions
If StrPtrLen(StrPtr(sArg(i))) Then
bFound = FALSE
If Peek(StrPtr(sArg(i))) = 38 Then
If Peek(StrPtr(sArg(i))+1) = 66 Then
'&B
bFound = is_Binary(sArg(i))
ElseIf Peek(StrPtr(sArg(i))+1) = 72 Then
'&H
bFound = is_Hex(sArg(i))
EndIf
EndIf
If Not bFound Then
If Array Scan sKeyword, Collate Ucase, = sArg(i) Then
bFound = TRUE
Else
If nExpressions Then
lFound = Array Scan sExpression, Collate Ucase, = sArg(i)
If lFound Then
lExpression(lFound) = 0
bFound = TRUE
EndIf
EndIf
EndIf
EndIf
If Not bFound Then
nExpressions += 1
If nExpressions > UBound(lExpression) Then
ReDim Preserve lExpression(nExpressions * 2)
ReDim Preserve sExpression(nExpressions * 2)
EndIf
sExpression(nExpressions) = sArg(i)
lExpression(nExpressions) = Start
EndIf
EndIf
End Select
Next
If lError = 0 Then Return TRUE
Select Case lAwait
Case %await_NONE
sErrors += Hex$(Start, 8) + "expected none, but found " + sFound + $CRLF
Case %await_EndFunction
sErrors += Hex$(Start, 8) + "expected END FUNCTION, but found " + sFound + $CRLF
Case %await_EndSub
sErrors += Hex$(Start, 8) + "expected END SUB, but found " + sFound + $CRLF
Case %await_EndWith
sErrors += Hex$(Start, 8) + "expected END WITH, but found " + sFound + $CRLF
Case %await_EndType
sErrors += Hex$(Start, 8) + "expected END TYPE, but found " + sFound + $CRLF
Case %await_EndUnion
sErrors += Hex$(Start, 8) + "expected END UNION, but found " + sFound + $CRLF
Case %await_DPlusENDIF
sErrors += Hex$(Start, 8) + "expected #ENDIF, but found " + sFound + $CRLF
Case %await_EndIf
sErrors += Hex$(Start, 8) + "expected ENDIF, but found " + sFound + $CRLF
Case %await_Case
sErrors += Hex$(Start, 8) + "expected CASE, but found " + sFound + $CRLF
Case %await_EndSelect
sErrors += Hex$(Start, 8) + "expected END SELECT, but found " + sFound + $CRLF
Case %await_Next
sErrors += Hex$(Start, 8) + "expected NEXT, but found " + sFound + $CRLF
Case %await_Wend
sErrors += Hex$(Start, 8) + "expected WEND, but found " + sFound + $CRLF
Case %await_Loop
sErrors += Hex$(Start, 8) + "expected LOOP, but found " + sFound + $CRLF
Case %await_Until
sErrors += Hex$(Start, 8) + "expected UNTIL, but found " + sFound + $CRLF
End Select
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' following two functions will help sort out binary and hex-expressions
' called from Check_Loops-function
Function is_Binary(ByVal sString As String) As Boolean
If StrPtrLen(StrPtr(sString)) < 3 Then Return FALSE
Local i As Long
For i = 3 To StrPtrLen(StrPtr(sString))
Select Case Peek(StrPtr(sString) + i - 1)
Case 48, 49
Case Else
Return FALSE
End Select
Next
Function = TRUE
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function is_Hex(ByVal sString As String) As Boolean
If StrPtrLen(StrPtr(sString)) < 3 Then Return FALSE
Local i As Long
For i = 3 To StrPtrLen(StrPtr(sString))
Select Case Peek(StrPtr(sString) + i - 1)
Case 48 To 57
Case 65 To 70
Case Else
Return FALSE
End Select
Next
Function = TRUE
End Function
' ------------------------------------------------------------------------------
Reply With Quote
... ok, I would rewrite it, so you pass some tB-script as String to the function and get some $crlf-delimited error-report back?
I think there are missing some Forum-sections as beta-testing and support
- perhaps the latest TBGL-Package can help - but I don't know for sure...
Originally Posted by ReneMiner
Edit: @ErosBut- anyway- tomorrow I'll take a look at tokenizer.
- also forgot to check for space in front of REM and - because I ran it on itself - found some useless, leftover variable.
Members who have read this thread: 0
Bookmarks