Ecco il codice di una form che funziona.
Ha un campo SQLCommand dove inserire il comando SQL, CMDAzione sono bottoni per lanciare l'esecuzione o uscire e se è una select carica la MSFlexGrid GRisultato.
Ho provato anche ad eliminare le classi mettendo tutti i richiami delle funzioni sqlite in un modulo, ma anche così non funziona. Nella routine tutto sembra andare bene, al rientro nella routine chiamante va tutto a meretrici, sembra che la memoria venga corrotta.
Option Explicit
Private mnColumn As Long
Private mbEOF As Boolean
Private mnErrCode As Long
Private mnDb As Long
Private mnStmt As Long
Private msSQL As String
Private maResult(256) As Variant
Private msCmpNome(256) As String
Private mnTipo(256) As Long
'==============================================================================================================================
Private Sub Form_Load()
Dim s As String, nRet As Long
'AbilitaControlli False
'ResettaCampi
VisualizzaComandi False
s = "C:\MyVBApp6\SQLiteGUI\TCLNames.db" & vbNullChar
mnDb = 0
mnErrCode = sqlite3_open(s, mnDb)
If mnErrCode <> SQLITE_OK Then
mnDb = 0
Unload Me
Else
Me.Caption = "SQLite GUI - Database=" + s
End If
SQLCommand.Text = "select * from names"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
FMain.mnuProvaDiretta.Enabled = True
If mnDb <> 0 Then
mnErrCode = sqlite3_close(mnDb)
End If
End Sub
Private Sub ResettaCampi()
Dim ctr As Control
For Each ctr In Me
If TypeOf ctr Is TextBox Then ctr.Text = ""
If TypeOf ctr Is ListBox Then ctr.ListIndex = -1
If TypeOf ctr Is ComboBox Then ctr.ListIndex = -1
If TypeOf ctr Is CheckBox Then ctr.Value = 0
Next
End Sub
Private Sub AbilitaControlli(ByVal vbValue As Boolean)
End Sub
Private Sub VisualizzaComandi(ByVal vbValue As Boolean)
Dim nI As Long
For nI = 3 To 7
cmdAzione(nI).Visible = False
Next nI
If vbValue = True Then
cmdAzione(6).Visible = False
cmdAzione(7).Visible = False
Else
' cmdAzione(5).Visible = False
cmdAzione(1).Visible = True
cmdAzione(2).Visible = True
End If
End Sub
Private Sub cmdAzione_Click(Index As Integer)
Dim nSelID As Long
Dim nRet As Long
Select Case Index
Case 0 ' esci
Unload Me
Case 4 ' Elimina
Case 3 ' aggiungi
Case 5 ' modifica
Case 7 ' Ripristina
Case 2 ' Annulla
Case 1 ' Conferma
If Not IsNothing(SQLCommand.Text) Then Esegui
End Select
End Sub
Private Sub Esegui()
Dim sSql As String, nI As Long
Dim s As String, rc As Long, nPtr As Long
GRisultato.Clear
sSql = SQLCommand.Text
If Left(UCase(sSql), 6) = "SELECT" Then
If Right(sSql, 1) <> ";" Then sSql = sSql + ";"
s = sSql & vbNullChar
mnErrCode = sqlite3_prepare_v2(mnDb, s, -1, mnStmt, 0)
If mnErrCode <> SQLITE_OK Then
ScriviGiornale "Errore prepare " & mnErrCode
Exit Sub
End If
mnColumn = sqlite3_column_count(mnStmt)
If mnColumn = 0 Then
mnStmt = 0
mbEOF = True
Exit Sub
End If
For nI = 0 To mnColumn - 1
msCmpNome(nI) = PtrToString(sqlite3_column_name(mnStmt, nI))
Next
GRisultato.Cols = mnColumn
GRisultato.Rows = 2
GRisultato.Row = 0
For nI = 0 To mnColumn - 1
GRisultato.col = nI
GRisultato.CellFontBold = True
GRisultato.CellBackColor = &HFFC0FF
GRisultato.Text = msCmpNome(nI)
Next
rc = sqlite3_step(mnStmt)
'ScriviGiornale "Prima lettura code=" & rc
While rc = SQLITE_ROW
GRisultato.Rows = GRisultato.Rows + 1
GRisultato.Row = GRisultato.Rows - 1
For nI = 0 To mnColumn - 1
mnTipo(nI) = sqlite3_column_type(mnStmt, nI)
If mnTipo(nI) = SQLITE_INTEGER Then
maResult(nI) = sqlite3_column_int(mnStmt, nI)
ElseIf mnTipo(nI) = SQLITE_FLOAT Then
maResult(nI) = sqlite3_column_double(mnStmt, nI)
ElseIf mnTipo(nI) = SQLITE_TEXT Then
nPtr = sqlite3_column_text(mnStmt, nI)
maResult(nI) = PtrToString(nPtr)
ElseIf mnTipo(nI) = SQLITE_NULL Then
maResult(nI) = Null
End If
GRisultato.col = nI
GRisultato.Text = maResult(nI) & ""
Next
rc = sqlite3_step(mnStmt)
Wend
mnErrCode = sqlite3_finalize(mnStmt)
Else
If Right(sSql, 1) <> ";" Then sSql = sSql + ";"
s = sSql & vbNullChar
' mnErrCode = sqlite3_exec(mnDb, s, 0, 0, 0)
mnErrCode = sqlite3_prepare_v2(mnDb, s, -1, mnStmt, 0)
rc = sqlite3_step(mnStmt)
mnErrCode = sqlite3_finalize(mnStmt)
End If
End Sub
' Converte da puntatore a stringa
Private Function PtrToString(ByVal lPtr As Long) As String
Dim L As Long, s As String
If lPtr = 0 Then Exit Function
L = lstrlenA(lPtr)
If L > 0 Then
s = String$(L, vbNullChar)
CopyMemory ByVal s, ByVal lPtr, L
End If
PtrToString = s
End Function