Private arrSQLErrorStrings(7) As String
Private arrPostTableSQLWords(7) As String
Type SQLErrorType(Near As Int, _
WrongNumberOfArguments As Int, _
UnknownOrUnsuportedJoin As Int, _
NoSuchTable As Int, _
NoSuchColumn As Int, _
NoSuchFunction As Int, _
UnrecognizedToken As Int, _
ConstraintException As Int)
Public eSQLErrorType As SQLErrorType
eSQLErrorType.Near = 0
eSQLErrorType.WrongNumberOfArguments = 1
eSQLErrorType.UnknownOrUnsuportedJoin = 2
eSQLErrorType.NoSuchTable = 3
eSQLErrorType.NoSuchColumn = 4
eSQLErrorType.NoSuchFunction = 5
eSQLErrorType.UnrecognizedToken = 6
eSQLErrorType.ConstraintException = 7
Sub ShowError(strTitle As String, strError As String, strExtra As String, strSQLHighlight As String) As ResumableSub
Dim iPos As Int
Dim strMsg As String
Dim bSQL As Boolean
Dim cs As CSBuilder
Dim csOld As CSBuilder
Dim strPrompt As String
Dim iNearPosStart As Int
Dim iNearPosEnd As Int
Dim iStartPos As Int
Dim iEndPos As Int
Dim strNearWord As String
Dim bHighLight As Boolean
Dim iSQLErrorType As Int
If strError.Length = 0 Then
strError = General.GetErrorString
End If
' General.RunLog("ShowError, strError: " & strError)
' General.RunLog("ShowError, strExtra: " & strExtra)
' General.RunLog("ShowError, strSQLHighlight: " & strSQLHighlight)
' General.RunLog("ShowError, CS_SQL.IsInitialized: " & CS_SQL.IsInitialized)
If strSQLHighlight.Length > 0 Then
strMsg = strError
If strExtra.Length > 0 Then
strMsg = strMsg & CRLF & CRLF & strExtra
End If
strNearWord = strSQLHighlight
bHighLight = True
bSQL = True
Else
If strTitle = "Error in Run SQL" Then
bSQL = True
iPos = strError.IndexOf("while compiling:")
If iPos = -1 Then 'eg: net.sqlcipher.CursorIndexOutOfBoundsException: Index 0 requested, with a size of 0
iPos = strError.IndexOf("ConstraintException")
If iPos = -1 Then
Return "No rows"
Else
'net.sqlcipher.database.SQLiteConstraintException: UNIQUE constraint failed: SAVED_SQL.NAME, SAVED_SQL.FOLDER_ID: update saved_sql set folder_id = 34 where sql like '%flag%'
iStartPos = strError.IndexOf("SQLiteConstraintException")
iEndPos = strError.LastIndexOf(":")
strMsg = strError.SubString2(iStartPos, iEndPos)
iSQLErrorType = Enums.eSQLErrorType.ConstraintException
End If
Else
strMsg = strError.SubString2(0, iPos - 4)
iNearPosStart = strMsg.IndexOf("Exception: ")
iSQLErrorType = GetSQLErrorType(strMsg)
End If
Select Case iSQLErrorType
Case Enums.eSQLErrorType.Near
iNearPosStart = iNearPosStart + 17
iNearPosEnd = strMsg.IndexOf2(Chr(34), iNearPosStart + 1)
If iNearPosEnd > -1 Then
strNearWord = strMsg.SubString2(iNearPosStart, iNearPosEnd)
End If
Case Enums.eSQLErrorType.WrongNumberOfArguments
iNearPosStart = iNearPosStart + 49
iNearPosEnd = strMsg.IndexOf2(Chr(40), iNearPosStart + 1)
strNearWord = strMsg.SubString2(iNearPosStart, iNearPosEnd)
Case Enums.eSQLErrorType.UnknownOrUnsuportedJoin
strNearWord = strMsg.SubString(iNearPosStart + 45)
Case Enums.eSQLErrorType.NoSuchTable
strNearWord = strMsg.SubString(iNearPosStart + 26)
Case Enums.eSQLErrorType.NoSuchColumn
strNearWord = strMsg.SubString(iNearPosStart + 27)
Case Enums.eSQLErrorType.NoSuchFunction
strNearWord = strMsg.SubString(iNearPosStart + 29)
Case Enums.eSQLErrorType.UnrecognizedToken
iNearPosStart = iNearPosStart + 32
iNearPosEnd = strMsg.IndexOf2(Chr(34), iNearPosStart + 1)
If iNearPosEnd > -1 Then
strNearWord = strMsg.SubString2(iNearPosStart, iNearPosEnd)
End If
End Select
End If
End If
If strTitle = "Error in Run SQL" Or bHighLight Then
If Enums.bNoSQLFormattingAtAll Then
strPrompt = strMsg & CRLF & CRLF & edtSQL.Text
Else
If strNearWord.Length = 0 Then
cs.Initialize.Color(Colors.Black)
cs.Append(strMsg & CRLF & CRLF).Pop
cs.Append(CS_SQL).PopAll
Else
cs.Initialize.Color(Colors.Black)
cs.Append(strMsg & CRLF & CRLF).Pop
csOld.Initialize
csOld.Append (CS_SQL)
cs.Append (HighLightCSBuilderString(CS_SQL, strNearWord, Colors.RGB(255, 200, 200)))
bHighLight = True
End If
End If
End If
If bSQL Then
If Enums.bNoSQLFormattingAtAll Then 'no SQL colour syntax highlighting
Dim rs As ResumableSub = Dialog.Show(Activity, Array As Object("OK"), _
strTitle, "", strPrompt, _
-1, False, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, Null, False, arrS, 1)
Wait For (rs) Complete (strResult As String)
Else
Dim rs As ResumableSub = Dialog.Show(Activity, Array As Object("OK"), _
strTitle, "", "", _
-1, False, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, cs, False, arrS, 1)
Wait For (rs) Complete (strResult As String)
End If
Else
If strExtra.Length > 0 Then
strError = strError & CRLF & CRLF & strExtra
End If
Dim rs As ResumableSub = Dialog.Show(Activity, Array As Object("OK"), _
strTitle, "", strError, _
-1, False, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, Null, False, arrS, 1)
Wait For (rs) Complete (strResult As String)
End If
If bHighLight Then
Enums.bNoSQLFormatting = True
edtSQL.Text = General.SubCharSequence2(cs, strMsg.Length + 2, -1)
Enums.bNoSQLFormatting = False
Enums.bShowingSQLErrorWord = True
Sleep(1000)
CS_SQL = csOld
edtSQL.Text = csOld
Enums.bShowingSQLErrorWord = False
End If
Return strError
End Sub
Sub GetSQLErrorType(strErrorMessage As String) As Int
Dim i As Int
For i = 0 To arrSQLErrorStrings.Length - 1
If strErrorMessage.IndexOf(arrSQLErrorStrings(i)) > -1 Then
Return i
End If
Next
Return -1
End Sub
Sub InitErrorStringArray
arrSQLErrorStrings(0) = "Exception: near "
arrSQLErrorStrings(1) = "Exception: wrong number of arguments to function"
arrSQLErrorStrings(2) = "Exception: unknown or unsupported join type: "
arrSQLErrorStrings(3) = "Exception: no such table: "
arrSQLErrorStrings(4) = "Exception: no such column: "
arrSQLErrorStrings(5) = "Exception: no such function: "
arrSQLErrorStrings(6) = "Exception: unrecognized token: "
End Sub
Sub InitPostTableSQLWords
arrPostTableSQLWords(0) = "where"
arrPostTableSQLWords(1) = "inner"
arrPostTableSQLWords(2) = "left"
arrPostTableSQLWords(3) = "order"
arrPostTableSQLWords(4) = "limit"
arrPostTableSQLWords(5) = "union"
arrPostTableSQLWords(6) = "." 'as we can have table.field!
End Sub
Sub HighLightCSBuilderString(oCS As CSBuilder, _
strString As String, _
iBackgroundColour As Int) As CSBuilder
Dim strCSB As String
Dim cs As CSBuilder
Dim iStart As Int
Dim iPos1 As Int
Dim iPos2 As Int
strCSB = oCS.ToString
cs.Initialize
iPos1 = strCSB.IndexOf(strString)
Do While iPos1 > -1
iPos2 = iPos1 + strString.Length
If iPos1 = 0 Then
cs.BackgroundColor(iBackgroundColour)
cs.Append(General.SubCharSequence2(oCS, iStart, iPos2)).Pop
Else
cs.Append (General.SubCharSequence2(oCS, iStart, iPos1)).BackgroundColor(iBackgroundColour)
cs.Append (General.SubCharSequence2(oCS, iPos1, iPos2)).Pop
End If
iStart = iPos2
iPos1 = strCSB.IndexOf2(strString, iPos2)
Loop
If iPos2 < strCSB.Length Then
cs.Append (General.SubCharSequence2(oCS, iPos2, strCSB.Length))
End If
Return cs
End Sub
Sub GetErrorString() As String
Dim strError As String
Dim iPos As Int
If LastException.IsInitialized = False Then
Return "No error"
Else
strError = LastException.Message
'RunLog("GetErrorString, strError: " & strError)
iPos = strError.IndexOf("###")
If iPos > -1 And iPos < strError.Length - 1 Then
strError = strError.SubString2(0, iPos)
End If
End If
Return strError
End Sub
