Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Util Plugin, MBS SQL Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Util/RecordSet to JSON
This example is the version from Mon, 14th Jul 2019.
Project "RecordSet to JSON.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
EventHandler Sub Open()
// open a Database
#if RBVersion < 2013 then
Dim ordersDB As New REALSQLDatabase
#else
Dim ordersDB As New SQLiteDatabase
#endif
ordersDB.DatabaseFile = GetFolderItem("Orders.sqlite")
If Not ordersDB.Connect Then
MsgBox("Database Error: " + Str(OrdersDB.ErrorCode) + EndOfLine + EndOfLine + OrdersDB.ErrorMessage)
Return
End If
// make a query
Dim r As RecordSet = ordersDB.SQLSelect("SELECT * FROM Customers")
// convert to JSON
Dim json As String = RecordSetToJSON(r)
// and back
Dim rr As RecordSet = JSONToRecords(json)
Break // inspect in debugger
End EventHandler
Function JSONToRecords(JSON as string) As RecordSet
// turns JSON back to RecordSet
// parse it
Dim j As JSONMBS = New JSONMBS(json)
// convert to Dictionary/Array/Variant
Dim d As Dictionary = j.Convert
// query our arrays
Dim vFieldNames() As Variant = d.Value("FieldNames")
Dim vValues() As Variant = d.Value("Values")
// convert to String arrays
Dim FieldNames() As String
Dim Values() As String
For Each FieldName As Variant In vFieldNames
FieldNames.Append FieldName
Next
For Each Value As Variant In vValues
Values.Append Value
Next
// Build recordset based on arrays
Return BuildRecordSetMBS(FieldNames, Values)
End Function
Function RecordSetToJSON(r as RecordSet) As String
// adds data in recordset to a JSON Dictionary
Dim FieldNames() As String
Dim Values() As String
// Query list of field names
Dim c As Integer = r.FieldCount
For i As Integer = 1 To c
Dim d As DatabaseField = r.IdxField(i)
FieldNames.Append d.Name
Next
// get all fields from all records into values array
While Not r.EOF
For i As Integer = 1 To c
Values.Append r.IdxField(i).StringValue
Next
r.MoveNext
Wend
// make new Dictionary with the values and field names
Dim j As New Dictionary
j.Value("FieldNames") = FieldNames
j.Value("Values") = Values
// Convert to JSON
Dim v As Variant = j
Dim json As JSONMBS = JSONMBS.Convert(v)
// return as JSON string
Return json.toString
End Function
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
End Project
The items on this page are in the following plugins: MBS Util Plugin.