' Code module
' Version 1.00
'CreateTable Sub modified by JanPRO
Sub Process_Globals
Public DB_REAL, DB_INTEGER, DB_BLOB, DB_TEXT As String
DB_REAL = "REAL"
DB_INTEGER = "INTEGER"
DB_BLOB = "BLOB"
DB_TEXT = "TEXT"
Private HtmlCSS As String
HtmlCSS = "table {font-family:helvetica;width: 100%;border: 1px solid #cef;text-align: left; }" _
& " th { font-weight: bold; background-color: #acf; border-bottom: 1px solid #cef; }" _
& "td,th { padding: 4px 5px; }" _
& ".odd {background-color: #def; } .odd td {border-bottom: 1px solid #cef; }" _
& "a { text-decoration:none; color: #000;}"
Log("dbutils process globals")
End Sub
'Copies a database file that was added in the Files tab. The database must be copied to a writable location.
'The target folder is returned.
'If the database file already exists then no copying is done.
Public Sub CopyDBFromAssets (FileName As String) As String
Dim TargetDir As String = File.DirDocuments
If File.Exists(TargetDir, FileName) = False Then
File.Copy(File.DirAssets, FileName, TargetDir, FileName)
End If
Return TargetDir
End Sub
'Creates a new table with the given name.
'FieldsAndTypes - A map with the fields names as keys and the types as values.
'You can use the DB_... constants for the types.
'PrimaryKey - The column that will be the primary key. Pass empty string if not needed.
Public Sub CreateTable(SQL As SQL, TableName As String, FieldsAndTypes As Map, PrimaryKey As String)
'Modified by JanPRO
Dim NaObj As NativeObject = Me
Dim BuildedString As String = NaObj.RunMethod("BuildString::",Array(FieldsAndTypes.ToDictionary,PrimaryKey)).AsString
Dim query As String
query = "CREATE TABLE IF NOT EXISTS [" & TableName & "] " & BuildedString
Log("CreateTable: " & query)
SQL.ExecNonQuery(query)
End Sub
#If Objc
-(NSString*)BuildString:(NSDictionary*)Dict :(NSString*)PrimaryKey{
B4IStringBuilder * SB = [B4IStringBuilder new];
[SB Initialize];
[SB Append:@"("];
int i = 0;
for(id key in Dict){
NSString * field = key;
NSString * ftype = [Dict objectForKey:key];
if(i > 0){[SB Append:@", "];}
[[[[SB Append:@"["] Append:field] Append:@("] ")] Append:ftype];
if([field isEqualToString:PrimaryKey]){[SB Append:@" PRIMARY KEY"];}
i = i + 1;
}
[SB Append:@")"];
return [SB ToString];
}
#End If
'Deletes the given table.
Public Sub DropTable(SQL As SQL, TableName As String)
Dim query As String
query = "DROP TABLE IF EXISTS [" & TableName & "]"
Log("DropTable: " & query)
SQL.ExecNonQuery(query)
End Sub
'Inserts the data to the table.
'ListOfMaps - A list with maps as items. Each map represents a record where the map keys are the columns names
'and the maps values are the values.
'Note that you should create a new map for each record (this can be done by calling Dim to redim the map).
Public Sub InsertMaps(SQL As SQL, TableName As String, ListOfMaps As List)
Dim sb, columns, values As StringBuilder
'Small check for a common error where the same map is used in a loop
If ListOfMaps.Size > 1 And ListOfMaps.Get(0) = ListOfMaps.Get(1) Then
Log("Same Map found twice in list. Each item in the list should include a different map object.")
Return
End If
SQL.BeginTransaction
Try
For i1 = 0 To ListOfMaps.Size - 1
sb.Initialize
columns.Initialize
values.Initialize
Dim listOfValues As List
listOfValues.Initialize
sb.Append("INSERT INTO [" & TableName & "] (")
Dim m As Map
m = ListOfMaps.Get(i1)
Dim i2 As Int = 0
For Each col As String In m.Keys
Dim value As Object = m.Get(col)
If i2 > 0 Then
columns.Append(", ")
values.Append(", ")
End If
columns.Append("[").Append(col).Append("]")
values.Append("?")
listOfValues.Add(value)
i2 = i2 + 1
Next
sb.Append(columns.ToString).Append(") VALUES (").Append(values.ToString).Append(")")
If i1 = 0 Then Log("InsertMaps (first query out of " & ListOfMaps.Size & "): " & sb.ToString)
SQL.ExecNonQuery2(sb.ToString, listOfValues)
Next
SQL.TransactionSuccessful
Catch
Log(LastException)
SQL.Rollback
End Try
End Sub
' updates a single field in a record
' Field is the column name
Public Sub UpdateRecord(SQL As SQL, TableName As String, Field As String, NewValue As Object, _
WhereFieldEquals As Map)
Dim sb As StringBuilder
sb.Initialize
sb.Append("UPDATE [").Append(TableName).Append("] SET [").Append(Field).Append("] = ? WHERE ")
If WhereFieldEquals.Size = 0 Then
Log("WhereFieldEquals map empty!")
Return
End If
Dim args As List
args.Initialize
args.Add(NewValue)
Dim i As Int
For Each key As String In WhereFieldEquals.Keys
If i > 0 Then sb.Append(" AND ")
sb.Append("[").Append(key).Append("] = ?")
args.Add(WhereFieldEquals.Get(key))
i = i + 1
Next
Log("UpdateRecord: " & sb.ToString)
SQL.ExecNonQuery2(sb.ToString, args)
End Sub
' updates multiple fields in a record
' in the Fields map the keys are the column names
Public Sub UpdateRecord2(SQL As SQL, TableName As String, Fields As Map, WhereFieldEquals As Map)
If WhereFieldEquals.Size = 0 Then
Log("WhereFieldEquals map empty!")
Return
End If
If Fields.Size = 0 Then
Log("Fields empty")
Return
End If
Dim sb As StringBuilder
sb.Initialize
sb.Append("UPDATE [").Append(TableName).Append("] SET ")
Dim args As List
args.Initialize
Dim i As Int
For Each key As String In Fields.Keys
If i<>Fields.Size-1 Then
sb.Append("[").Append(key).Append("]=?,")
Else
sb.Append("[").Append(key).Append("]=?")
End If
args.Add(Fields.Get(key))
i = i + 1
Next
sb.Append(" WHERE ")
i = 0
For Each key As String In WhereFieldEquals.Keys
If i > 0 Then
sb.Append(" AND ")
End If
sb.Append("[").Append(key).Append("] = ?")
args.Add(WhereFieldEquals.Get(key))
i = i + 1
Next
Log("UpdateRecord: " & sb.ToString)
SQL.ExecNonQuery2(sb.ToString, args)
End Sub
'Executes the query and returns the result as a list of arrays.
'Each item in the list is a strings array.
'StringArgs - Values to replace question marks in the query. Pass Null if not needed.
'Limit - Limits the results. Pass 0 for all results.
Public Sub ExecuteMemoryTable(SQL As SQL, Query As String, StringArgs() As String, Limit As Int) As List
Dim rs As ResultSet = SQL.ExecQuery2(Query, StringArgs)
Log("ExecuteMemoryTable: " & Query)
Dim table As List
table.Initialize
Do While rs.NextRow
If Limit > 0 And table.Size > Limit Then Exit
Dim values(rs.ColumnCount) As String
For col = 0 To rs.ColumnCount - 1
values(col) = rs.GetString2(col)
Next
table.Add(values)
Loop
rs.Close
Return table
End Sub
'Executes the query and returns a Map with the column names as the keys
'and the first record values As the entries values.
'The keys are lower cased.
'Returns an uninitialized map if no results found.
Public Sub ExecuteMap(SQL As SQL, Query As String, StringArgs() As String) As Map
Dim rs As ResultSet = SQL.ExecQuery2(Query, StringArgs)
Dim res As Map
Log("ExecuteMap: " & Query)
If rs.NextRow = False Then
Log("No records found.")
Return res
End If
res.Initialize
For i = 0 To rs.ColumnCount - 1
res.Put(rs.GetColumnName(i).ToLowerCase, rs.GetString2(i))
Next
rs.Close
Return res
End Sub
Public Sub ExecuteList(SQL As SQL, Query As String, StringArgs() As String, _
Limit As Int) As List
Dim table As List = ExecuteMemoryTable(SQL, Query, StringArgs, Limit)
Dim items As List
items.Initialize
For Each row() As String In table
If Limit > 0 And items.Size >= Limit Then Exit
items.Add(row(0))
Next
Return items
End Sub
'Executes the query and fills the ListView with the value.
'If TwoLines is true then the first column is mapped to the first line and the second column is mapped
'to the second line.
'In both cases the value set to the row is the array with all the records values.
'Sub ExecuteListView(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, ListView1 As ListView, _
' TwoLines As Boolean)
' ListView1.Clear
' Dim Table As List
' Table = ExecuteMemoryTable(SQL, Query, StringArgs, Limit)
' Dim Cols() As String
' For i = 0 To Table.Size - 1
' Cols = Table.Get(i)
' If TwoLines Then
' ListView1.AddTwoLines2(Cols(0), Cols(1), Cols)
' Else
' ListView1.AddSingleLine2(Cols(0), Cols)
' End If
' Next
'End Sub
'Executes the given query and creates a Map that you can pass to JSONGenerator and generate JSON text.
'DBTypes - Lists the type of each column in the result set.
'Usage example:<code> (don't forget to add a reference to the JSON library)
' Dim gen As JSONGenerator
' gen.Initialize(DBUtils.ExecuteJSON(SQL, "SELECT Id, Birthday FROM Students", Null, _
' 0, Array As String(DBUtils.DB_TEXT, DBUtils.DB_INTEGER)))
' Dim JSONString As String
' JSONString = gen.ToPrettyString(4)
' Log(JSONString)</code>
Public Sub ExecuteJSON (SQL As SQL, Query As String, StringArgs() As String, Limit As Int, DBTypes As List) As Map
Dim table As List
Dim cur As ResultSet = SQL.ExecQuery2(Query, StringArgs)
Log("ExecuteJSON: " & Query)
Dim table As List
table.Initialize
Do While cur.NextRow
Dim m As Map
m.Initialize
For i = 0 To cur.ColumnCount - 1
Select DBTypes.Get(i)
Case DB_TEXT
m.Put(cur.GetColumnName(i), cur.GetString2(i))
Case DB_INTEGER
m.Put(cur.GetColumnName(i), cur.GetLong2(i))
Case DB_REAL
m.Put(cur.GetColumnName(i), cur.GetDouble2(i))
Case Else
Log("Invalid type: " & DBTypes.Get(i))
End Select
Next
table.Add(m)
If Limit > 0 And table.Size >= Limit Then Exit
Loop
cur.Close
Dim root As Map
root.Initialize
root.Put("root", table)
Return root
End Sub
'Creates a html text that displays the data in a table.
'The style of the table can be changed by modifying HtmlCSS variable.
Public Sub ExecuteHtml(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, Clickable As Boolean) As String
Dim cur As ResultSet = SQL.ExecQuery2(Query, StringArgs)
Log("ExecuteHtml: " & Query)
Dim sb As StringBuilder
sb.Initialize
sb.Append("<html><body>").Append(CRLF)
sb.Append("<style type='text/css'>").Append(HtmlCSS).Append("</style>").Append(CRLF)
sb.Append("<table><tr>").Append(CRLF)
For i = 0 To cur.ColumnCount - 1
sb.Append("<th>").Append(cur.GetColumnName(i)).Append("</th>")
Next
sb.Append("</tr>").Append(CRLF)
Dim row As Int
Do While cur.NextRow
If row Mod 2 = 0 Then
sb.Append("<tr>")
Else
sb.Append("<tr class='odd'>")
End If
For i = 0 To cur.ColumnCount - 1
sb.Append("<td>")
If Clickable Then
sb.Append("<a href='http://").Append(i).Append(".")
sb.Append(row)
sb.Append(".com'>").Append(cur.GetString2(i)).Append("</a>")
Else
sb.Append(cur.GetString2(i))
End If
sb.Append("</td>")
Next
sb.Append("</tr>").Append(CRLF)
row = row + 1
If Limit > 0 And row >= Limit Then Exit
Loop
cur.Close
sb.Append("</table></body></html>")
Return sb.ToString
End Sub
'Gets the current version of the database. If the DBVersion table does not exist it is created and the current
'version is set to version 1.
Public Sub GetDBVersion (SQL As SQL) As Int
Dim count, version As Int
count = SQL.ExecQuerySingleResult("SELECT count(*) FROM sqlite_master WHERE Type='table' AND name='DBVersion'")
If count > 0 Then
version = SQL.ExecQuerySingleResult("SELECT version FROM DBVersion")
Else
'Create the versions table.
Dim m As Map
m.Initialize
m.Put("version", DB_INTEGER)
CreateTable(SQL, "DBVersion", m, "version")
SQL.ExecNonQuery("INSERT INTO DBVersion VALUES (1)")
version = 1
End If
Return version
End Sub
'Sets the database version to the given version number.
Public Sub SetDBVersion (SQL As SQL, Version As Int)
SQL.ExecNonQuery2("UPDATE DBVersion set version = ?", Array As Object(Version))
End Sub
' deletes a record
Public Sub DeleteRecord(SQL As SQL, TableName As String, WhereFieldEquals As Map)
Dim sb As StringBuilder
sb.Initialize
sb.Append("DELETE FROM [").Append(TableName).Append("] WHERE ")
If WhereFieldEquals.Size = 0 Then
Log("WhereFieldEquals map empty!")
Return
End If
Dim args As List
args.Initialize
Dim i As Int = 0
For Each field As String In WhereFieldEquals.Keys
If i > 0 Then sb.Append(" AND ")
sb.Append("[").Append(field).Append("] = ?")
args.Add(WhereFieldEquals.Get(field))
i = i + 1
Next
Log("DeleteRecord: " & sb.ToString)
SQL.ExecNonQuery2(sb.ToString, args)
End Sub
