Class App Inherits Application

Const kEditClear = "&Löschen"

Const kFileQuit = "Beenden"

Const kFileQuitShortcut = ""

End Class

Class Window1 Inherits Window

EventHandler Sub Open() rowCount=10000 InitMBS InitREAL End EventHandler

Sub InitMBS() // use internal sqlite library call InternalSQLiteLibraryMBS.Use #pragma DisableBackgroundTasks try con = new SQLConnectionMBS // connection object // where is the library? if TargetMachO then 'con.Option(con.kOptionLibrarySQLite) = "/usr/lib/libsqlite3.0.dylib" end if if TargetLinux then 'con.Option(con.kOptionLibrarySQLite) = /usr/lib/libsqlite3.so.0.8.6" end if // for Windows place the sqlite3.dll in the same folder as the .exe file. // connect to database dim t as FolderItem = GetTemporaryFolderItem #if RBVersion >= 2013 then // Xojo dim path as string = t.NativePath #else // Real Studio dim path as string = t.UnixpathMBS #endif con.Connect(path, "", "",SQLConnectionMBS.kSQLiteClient) // associate a command with connection // connection can also be specified in SACommand constructor dim cmd as new SQLCommandMBS(con, "CREATE TABLE Test(Value INTEGER, OtherValue Integer, Text VARCHAR(20), PRIMARY KEY (Value))") cmd.Execute m1.text="OK" // get version cmd = new SQLCommandMBS(con, "select sqlite_version()") cmd.Execute if cmd.isResultSet then if cmd.FetchNext then MVersion.Text = cmd.Field(1).asStringValue end if end if // increase cache cmd = new SQLCommandMBS(con, "PRAGMA cache_size = 20000") cmd.Execute catch r as SQLErrorExceptionMBS // show error message m1.text="Failed" MsgBox r.message end try End Sub

Sub InitREAL() #pragma DisableBackgroundTasks dim t as FolderItem = GetTemporaryFolderItem db=new REALSQLDatabase db.DatabaseFile=t if db.CreateDatabaseFile then db.SQLExecute "CREATE TABLE Test(Value INTEGER, OtherValue Integer, Text VARCHAR(20), PRIMARY KEY (Value))" if db.Error then r1.Text="Failed" MsgBox db.ErrorMessage else r1.text="OK" end if // get version dim r as RecordSet = db.SQLSelect("select sqlite_version()") RVersion.Text = r.IdxField(1).StringValue // increase cache db.SQLExecute "PRAGMA cache_size = 20000" else r1.text="Failed" MsgBox db.ErrorMessage end if End Sub

Sub InsertMBS() #pragma DisableBackgroundTasks dim cmd as SQLCommandMBS cmd = new SQLCommandMBS(con, "Delete from Test") cmd.Execute dim t as double = microseconds cmd = new SQLCommandMBS(con, "BEGIN") cmd.Execute cmd = new SQLCommandMBS(con, "Insert into Test (Value, OtherValue, Text) values (:1, :2, :3)") for i as integer = 1 to rowCount cmd.Param(1).setAsLong i cmd.Param(2).setAsLong 5 cmd.Param(3).setAsString "VC"+str(i) cmd.Execute next cmd = new SQLCommandMBS(con, "COMMIT") cmd.Execute t = microseconds-t M2.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub InsertREAL() #pragma DisableBackgroundTasks db.SQLExecute "Delete from Test" dim t as double = microseconds db.SQLExecute "BEGIN" for i as integer = 1 to rowCount dim rec as New DatabaseRecord rec.IntegerColumn("Value")=i rec.IntegerColumn("OtherValue")=5 rec.Column("Text")="VC"+str(i) db.InsertRecord ("Test", rec) If db.Error then MsgBox "database error: "+db.ErrorMessage Return end if next db.SQLExecute "COMMIT" t = microseconds - t R2.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadFieldMBS() #pragma DisableBackgroundTasks dim t as double = microseconds dim cmd as SQLCommandMBS cmd = new SQLCommandMBS(con, "Select Value, OtherValue, Text from Test") // create command object // Select from our test table cmd.Execute dim ValueField as SQLFieldMBS = cmd.Field(1) dim OtherValueField as SQLFieldMBS = cmd.Field(2) dim TextField as SQLFieldMBS = cmd.Field(3) // fetch results row by row and print results dim Value, OtherValue as integer dim Text as string while cmd.FetchNext 'dim dt as integer = ValueField.DataType 'dim ft as integer = ValueField.FieldType Value = ValueField.asLong OtherValue = OtherValueField.asLong Text = TextField.asStringValue wend t = microseconds - t M5.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadFieldREAL() #pragma DisableBackgroundTasks dim t as double = microseconds dim r as RecordSet = db.SQLSelect("Select Value, OtherValue, Text from Test") dim ValueField as DatabaseField = r.IdxField(1) dim OtherValueField as DatabaseField = r.IdxField(2) dim TextField as DatabaseField = r.IdxField(3) dim Value, OtherValue as integer dim Text as string while not r.eof Value = ValueField.IntegerValue OtherValue = OtherValueField.IntegerValue Text = TextField.StringValue r.MoveNext wend t = microseconds - t R5.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadIndexMBS() #pragma DisableBackgroundTasks dim t as double = microseconds dim cmd as SQLCommandMBS cmd = new SQLCommandMBS(con, "Select Value, OtherValue, Text from Test") // create command object // Select from our test table cmd.Execute dim Value, OtherValue as integer dim Text as string // fetch results row by row and print results while cmd.FetchNext Value = cmd.Field(1).asLong OtherValue = cmd.Field(2).asLong Text = cmd.Field(3).asStringValue wend t = microseconds - t M4.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadIndexREAL() #pragma DisableBackgroundTasks dim t as double = microseconds dim r as RecordSet = db.SQLSelect("Select Value, OtherValue, Text from Test") dim Value, OtherValue as integer dim Text as string while not r.eof Value = r.IdxField(1).IntegerValue OtherValue = r.IdxField(2).IntegerValue Text = r.IdxField(3).StringValue r.MoveNext wend t = microseconds - t R4.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadNameMBS() #pragma DisableBackgroundTasks dim t as double = microseconds dim cmd as SQLCommandMBS cmd = new SQLCommandMBS(con, "Select Value, OtherValue, Text from Test") // create command object // Select from our test table cmd.Execute dim Value, OtherValue as integer dim Text as string // fetch results row by row and print results while cmd.FetchNext Value = cmd.Field("Value").asLong OtherValue = cmd.Field("OtherValue").asLong Text = cmd.Field("Text").asStringValue wend t = microseconds - t M3.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub ReadNameREAL() #pragma DisableBackgroundTasks dim t as double = microseconds dim r as RecordSet = db.SQLSelect("Select Value, OtherValue, Text from Test") dim Value, OtherValue as integer dim Text as string while not r.eof Value = r.Field("Value").IntegerValue OtherValue = r.Field("OtherValue").IntegerValue Text = r.Field("Text").StringValue r.MoveNext wend t = microseconds - t R3.text=Format(t/1000000, "0.0")+" seconds" End Sub

Sub UpdateMemory() oc.text=str(Runtime.ObjectCount)+" objects, "+str(Runtime.MemoryUsed)+" bytes" End Sub

Property con As SQLConnectionMBS

Property db As REALSQLDatabase

Property rowCount As Integer

End Class

MenuBar MenuBar1

MenuItem FileMenu = "&Ablage"

MenuItem FileQuit = "#App.kFileQuit"

MenuItem EditMenu = "&Bearbeiten"

MenuItem EditUndo = "&Rückgängig"

MenuItem UntitledMenu1 = "-"

MenuItem EditCut = "&Ausschneiden"

MenuItem EditCopy = "&Kopieren"

MenuItem EditPaste = "&Einfügen"

MenuItem EditClear = "#App.kEditClear"

MenuItem UntitledMenu0 = "-"

MenuItem EditSelectAll = "&Alles auswählen"

End MenuBar