You find this example project in your Plugins Download as a Xojo project file within the examples folder: /SQL/SQLite Lock Test/SQLite Busy Handler
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control Thread1 Inherits MyThread
ControlInstance Thread1 Inherits MyThread
EventHandler Sub Run()
test me
End EventHandler
End Control
Control Thread2 Inherits MyThread
ControlInstance Thread2 Inherits MyThread
EventHandler Sub Run()
test me
End EventHandler
End Control
Control Thread3 Inherits MyThread
ControlInstance Thread3 Inherits MyThread
EventHandler Sub Run()
test me
End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control Label2 Inherits Label
ControlInstance Label2 Inherits Label
End Control
Control Label3 Inherits Label
ControlInstance Label3 Inherits Label
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
label1.Text = str(Thread1.counter)
label2.Text = str(Thread2.counter)
label3.Text = str(Thread3.counter)
End EventHandler
End Control
EventHandler Sub Open()
call InternalSQLiteLibraryMBS.Use
Thread1.run
Thread2.run
Thread3.run
End EventHandler
Function FindFile(name as string) As FolderItem
// Look for file in parent folders from executable on
dim parent as FolderItem = app.ExecutableFile.Parent
while parent<>Nil
dim file as FolderItem = parent.Child(name)
if file<>Nil and file.Exists then
Return file
end if
parent = parent.Parent
wend
End Function
Sub test(m as MyThread)
dim db as new SQLDatabaseMBS
m.Sleep(1000)
dim dbFile as FolderItem = FindFile("mydatabase.sqlite")
dim dbPath as string
#if RBVersion < 2013
dbPath = dbFile.UnixpathMBS
#else
dbPath = dbFile.NativePath
#endif
db.DatabaseName = "sqlite:" + dbPath
if db.Connect then
m.Sleep(1000)
// without setting busy handler, the database can get locked
db.SQLiteSetBusyHandler(500)
do
m.counter = m.counter + 1
// do some SQL
db.SQLExecuteMT "UPDATE test SET column1 = '"+str(rnd)+"'"
if db.Error then
Dim e As String = db.ErrorMessage
MsgBox e
break
end if
loop
else
Break
end if
End Sub
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class MyThread Inherits Thread
Property counter As Integer
End Class