B4J=true Group=Default Group ModulesStructureVersion=1 Type=StaticCode Version=5.9 @EndOfDesignText@ 'version 1.01c #IgnoreWarnings:12 Sub Process_Globals Public const DB_REAL As String = "REAL" Public const DB_INTEGER As String = "INTEGER" Public const DB_BLOB As String = "BLOB" Public const DB_TEXT As String = "TEXT" Public const DB_FLOAT As String = "FLOAT" Public const DB_NUMERIC As String = "NUMERIC" Dim HtmlCSS As String = "table {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;}" Private pool As ConnectionPool Public SQLite As SQL Public UsePool As Boolean Private DatabaseType As Int Public RanOK As Boolean Private tbl2Create As String Private tflds As Map Private tidxs As Map Private tprikey As String Private tauto As String Public IsDone As Boolean Public const TRIGGER_BEFORE_INSERT As String = "BEFORE INSERT" Public const TRIGGER_BEFORE_UPDATE As String = "BEFORE UPDATE" Public const TRIGGER_BEFORE_DELETE As String = "BEFORE DELETE" Public const TRIGGER_AFTER_INSERT As String = "AFTER INSERT" Public const TRIGGER_AFTER_UPDATE As String = "AFTER UPDATE" Public const TRIGGER_AFTER_DELETE As String = "AFTER DELETE" Public const TRIGGER_INSTEADOF_INSERT As String = "INSTEAD OF INSERT" Public const TRIGGER_INSTEADOF_UPDATE As String = "INSTEAD OF UPDATE" Public const TRIGGER_INSTEADOF_DELETE As String = "INSTEAD OF DELETE" End Sub 'create a trigger when an event happens Sub SQLiteCreateTriggerWhen(triggerName As String, tblName As String, triggerWhenEvent As String, triggerWhenSQL As String, triggerSQL As String) As String triggerName = triggerName.Replace(" ","") Dim script As String = $"CREATE TRIGGER IF NOT EXISTS ${triggerName} ${triggerWhenEvent} ON ${tblName} WHEN ${triggerWhenSQL} BEGIN ${triggerSQL} END;"$ Return script End Sub 'create a trigger without when Sub SQLiteCreateTrigger(triggerName As String, tblName As String, triggerWhenEvent As String, triggerSQL As String) As String triggerName = triggerName.Replace(" ","") Dim script As String = $"CREATE TRIGGER IF NOT EXISTS ${triggerName} ${triggerWhenEvent} ON ${tblName} BEGIN ${triggerSQL} END;"$ Return script End Sub ' copy db from assets Sub CopyDatabase(Database As String, bReplace As Boolean) Database = Database.ToLowerCase If bReplace = True Then File.Copy(File.DirAssets,Database, File.dirapp,Database) Else If File.Exists(File.dirapp,Database) = False Then File.Copy(File.DirAssets,Database, File.dirapp,Database) End If End If End Sub 'create an table with auto increment id Sub SQLiteCreateTable(jSQL As SQL, tblName As String, newFields As Map, pkName As String, aiName As String) As Boolean Dim fldName As String Dim fldType As String Dim fldTot As Int Dim fldCnt As Int 'create the audit trail table fldTot = newFields.Size - 1 Dim sb As StringBuilder sb.Initialize sb.Append("(") For fldCnt = 0 To fldTot fldName = newFields.GetKeyAt(fldCnt) fldType = newFields.GetValueAt(fldCnt) If fldCnt > 0 Then sb.Append(", ") sb.Append(EscapeField(fldName)).Append(" ").Append(fldType) If fldType = DB_TEXT Then sb.Append(" COLLATE NOCASE") If fldName.EqualsIgnoreCase(pkName) Then sb.Append(" NOT NULL PRIMARY KEY") If fldName.EqualsIgnoreCase(aiName) Then sb.Append(" AUTOINCREMENT") Next sb.Append(")") 'define the qry to execute Dim query As String = "CREATE TABLE IF NOT EXISTS " & EscapeField(tblName) & " " & sb.ToString 'run the query jSQL.ExecNonQuery(query) Return SQLiteTableExists(jSQL,tblName) End Sub 'create an audit trail Sub SQLiteCreateAuditTrail(jSQL As SQL, tblName As String) As Boolean 'define the audit trail table name Dim auditTrailTable As String = $"${tblName}_Audit"$ 'define the primary key Dim auditTrailPK As String = "id" 'define the field to autoincrement Dim auditTrailAI As String = "id" Dim fldName As String Dim fldType As String 'first get the structure of an existing table, lets leave the indexes out Dim existingTable As Map = GetTableStructure(jSQL,tblName) 'for each field, create a new table with the cloned fields for old_ and new_ Dim newFields As Map newFields.Initialize Dim fldTot As Int = existingTable.Size - 1 Dim fldCnt As Int For fldCnt = 0 To fldTot 'get the fldname and fldtype to create the old_x and new_x fldName = existingTable.GetKeyAt(fldCnt) fldType = existingTable.GetValueAt(fldCnt) Dim old_fldName As String = $"old_${fldName}"$ Dim new_fldName As String = $"new_${fldName}"$ newFields.Put(old_fldName,fldType) newFields.Put(new_fldName,fldType) Next 'just ensure we have an id field newFields.Put(auditTrailPK,DB_INTEGER) 'ensure we have an audit date field newFields.Put("Audit_Date", DB_TEXT) 'ensure we have the type of action newFields.Put("Audit_Action", DB_TEXT) 'create the audit trail table Dim atTable As Boolean = SQLiteCreateTable(jSQL,auditTrailTable,newFields,auditTrailPK,auditTrailAI) Return atTable End Sub 'create an update trigger Sub SQLiteCreateAfterUpdateTrigger(jSQL As SQL, tblName As String) As Boolean 'define the trigger name Dim triggerName As String = $"${tblName}_after_update"$ 'define the audit trail table name Dim auditTrailTable As String = $"${tblName}_Audit"$ 'first get the structure of an existing table, lets leave the indexes out Dim existingTable As Map = GetTableStructure(jSQL,tblName) 'for each existing field, lets build when Dim sbWhen As StringBuilder sbWhen.Initialize 'for each existing field, lets build inserts Dim sbInsert As StringBuilder sbInsert.Initialize sbInsert.Append($"INSERT INTO ${auditTrailTable} ("$).Append(CRLF) 'for each existing field, lets build values Dim sbValues As StringBuilder sbValues.Initialize For Each fldName As String In existingTable.Keys 'when any of the fields are not the same, create an audit trail Dim notSame As String = $"old.${fldName} <> new.${fldName}"$ sbWhen.Append(notSame).Append(CRLF).Append("OR ") 'build the insert fiels Dim old_fldName As String = $"old_${fldName}"$ Dim new_fldName As String = $"new_${fldName}"$ sbInsert.Append(old_fldName).Append(",").Append(CRLF) sbInsert.Append(new_fldName).Append(",").Append(CRLF) 'build values old_fldName = $"old.${fldName}"$ new_fldName = $"new.${fldName}"$ sbValues.Append(old_fldName).Append(",").Append(CRLF) sbValues.Append(new_fldName).Append(",").Append(CRLF) Next 'clean when last 'OR ' sbWhen.Remove(sbWhen.Length-3,sbWhen.Length) 'update the insert to include audit action and audit date sbInsert.Append("Audit_Action,").Append(CRLF) sbInsert.Append("Audit_Date").Append(CRLF) 'do the same for the values sbValues.Append("'UPDATE',").Append(CRLF) sbValues.Append("DATETIME('NOW')").Append(CRLF) sbInsert.Append(")").Append(CRLF) sbInsert.Append("VALUES").Append(CRLF) sbInsert.Append("(").Append(CRLF) sbInsert.Append(sbValues.ToString) sbInsert.Append(");").Append(CRLF) 'lets define the trigger. Dim trigger As String = SQLiteCreateTriggerWhen(triggerName,tblName,TRIGGER_AFTER_UPDATE,sbWhen.ToString,sbInsert.ToString) jSQL.ExecNonQuery(trigger) Return SQLiteTriggerExists(jSQL,triggerName) End Sub 'create an after insert trigger Sub SQLiteCreateAfterInsertTrigger(jSQL As SQL, tblName As String) As Boolean 'define the trigger name Dim triggerName As String = $"${tblName}_after_insert"$ 'define the audit trail table name Dim auditTrailTable As String = $"${tblName}_Audit"$ 'first get the structure of an existing table, lets leave the indexes out Dim existingTable As Map = GetTableStructure(jSQL,tblName) 'for each existing field, lets build inserts Dim sbInsert As StringBuilder sbInsert.Initialize sbInsert.Append($"INSERT INTO ${auditTrailTable} ("$).Append(CRLF) 'for each existing field, lets build values Dim sbValues As StringBuilder sbValues.Initialize For Each fldName As String In existingTable.Keys 'build the insert fiels Dim new_fldName As String = $"new_${fldName}"$ sbInsert.Append(new_fldName).Append(",").Append(CRLF) 'build values new_fldName = $"new.${fldName}"$ sbValues.Append(new_fldName).Append(",").Append(CRLF) Next 'update the insert to include audit action and audit date sbInsert.Append("Audit_Action,").Append(CRLF) sbInsert.Append("Audit_Date").Append(CRLF) 'do the same for the values sbValues.Append("'CREATE',").Append(CRLF) sbValues.Append("DATETIME('NOW')").Append(CRLF) sbInsert.Append(")").Append(CRLF) sbInsert.Append("VALUES").Append(CRLF) sbInsert.Append("(").Append(CRLF) sbInsert.Append(sbValues.ToString) sbInsert.Append(");").Append(CRLF) 'lets define the trigger. Dim trigger As String = SQLiteCreateTrigger(triggerName,tblName,TRIGGER_AFTER_INSERT,sbInsert.ToString) jSQL.ExecNonQuery(trigger) Return SQLiteTriggerExists(jSQL,triggerName) End Sub 'create an after delete trigger Sub SQLiteCreateAfterDeleteTrigger(jSQL As SQL, tblName As String) As Boolean 'define the trigger name Dim triggerName As String = $"${tblName}_after_delete"$ 'define the audit trail table name Dim auditTrailTable As String = $"${tblName}_Audit"$ 'first get the structure of an existing table, lets leave the indexes out Dim existingTable As Map = GetTableStructure(jSQL,tblName) 'for each existing field, lets build inserts Dim sbInsert As StringBuilder sbInsert.Initialize sbInsert.Append($"INSERT INTO ${auditTrailTable} ("$).Append(CRLF) 'for each existing field, lets build values Dim sbValues As StringBuilder sbValues.Initialize For Each fldName As String In existingTable.Keys 'build the insert fiels Dim new_fldName As String = $"old_${fldName}"$ sbInsert.Append(new_fldName).Append(",").Append(CRLF) 'build values new_fldName = $"old.${fldName}"$ sbValues.Append(new_fldName).Append(",").Append(CRLF) Next 'update the insert to include audit action and audit date sbInsert.Append("Audit_Action,").Append(CRLF) sbInsert.Append("Audit_Date").Append(CRLF) 'do the same for the values sbValues.Append("'DELETE',").Append(CRLF) sbValues.Append("DATETIME('NOW')").Append(CRLF) sbInsert.Append(")").Append(CRLF) sbInsert.Append("VALUES").Append(CRLF) sbInsert.Append("(").Append(CRLF) sbInsert.Append(sbValues.ToString) sbInsert.Append(");").Append(CRLF) 'lets define the trigger. Dim trigger As String = SQLiteCreateTrigger(triggerName,tblName,TRIGGER_AFTER_DELETE,sbInsert.ToString) jSQL.ExecNonQuery(trigger) Return SQLiteTriggerExists(jSQL,triggerName) End Sub 'check to see if SQLite table exists Sub SQLiteTableExists(jSQL As SQL, tblName As String) As Boolean Dim res As String Try Dim qry As String = $"select tbl_name from sqlite_master where type = 'table' and lower(tbl_name) = ?"$ res = jSQL.ExecQuerySingleResult2(qry, Array As String(tblName.tolowercase)) Catch Return False End Try If res = Null Then Return False Else Return True End If End Sub 'check to see if SQLite trigger exists Sub SQLiteTriggerExists(jSQL As SQL, tblName As String) As Boolean Dim res As String Try Dim qry As String = $"select name from sqlite_master where type = 'trigger' and lower(name) = ?"$ res = jSQL.ExecQuerySingleResult2(qry, Array As String(tblName.tolowercase)) Catch Return False End Try If res = Null Then Return False Else Return True End If End Sub Public Sub ExecuteHtml(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, Clickable As Boolean) As String Dim cur As ResultSet If StringArgs <> Null Then cur = SQL.ExecQuery2(Query, StringArgs) Else cur = SQL.ExecQuery(Query) End If Log ("ExecuteHtml: " & Query) Dim sb As StringBuilder sb.Initialize sb.Append("").Append (CRLF) sb.Append("").Append (CRLF) sb.Append("").Append (CRLF) For i = 0 To cur.ColumnCount - 1 sb.Append("") Next sb.Append ("") ' For i = 0 To cur.ColumnCount - 1 ' If i = 1 Then ' sb.Append("") ' Else ' sb.Append("") ' End If ' Next sb.Append("").Append (CRLF) Dim row As Int Do While cur.NextRow If row Mod 2 = 0 Then sb.Append ("") Else sb.Append ("") End If For i = 0 To cur.ColumnCount - 1 sb.Append ("") Next sb.Append("").Append (CRLF) row = row + 1 Loop cur.Close sb.Append ("
").Append(cur.GetColumnName(i)).Append ("
").Append(cur.GetColumnName(i)).Append("").Append(cur.GetColumnName(i)).Append("
") If Clickable Then sb.Append("").Append(cur.GetString2(i)).Append ("") Else sb.Append (cur.GetString2(i)) End If sb.Append ("
") Return sb.ToString End Sub 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 If StringArgs <> Null Then cur = SQL.ExecQuery2(Query, StringArgs) Else cur = SQL.ExecQuery(Query) End If 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 Public Sub Execute2List(SQL As SQL, Query As String, StringArgs() As String, Limit As Int) As List Dim Table As List = ExecuteMemoryTable(SQL, Query, StringArgs, Limit) Dim res As List res.Initialize For Each Cols() As String In Table res.Add (Cols(0)) Next Return res End Sub private Sub ConcatenateFields(iSQL As SQL, Table As String) 'update macros set key = framework || '.' || macro End Sub 'use a particular field in a table to create a table with those distinct records Sub CreateListFromAnotherTable(iSQL As SQL,SourceTable As String,SourceField As String,TargetTable As String, TargetField As String, TargetPriKey As String) 'select from the source table Dim cats As List = ExecuteMaps(iSQL,$"select ${SourceField} from ${SourceTable} group by ${SourceField}"$,Null) 'clear the target table TableClear(iSQL,TargetTable) 'reset the counter for target SQLiteResetCounter(iSQL,TargetTable,TargetPriKey) Dim nList As List nList.Initialize For Each catM As Map In cats Dim scategory As String = catM.GetDefault(SourceField.tolowercase,"") Dim nrec As Map = CreateMap(TargetField.tolowercase:scategory) nList.Add(nrec) Next InsertMaps(iSQL,TargetTable,nList,False) End Sub public Sub LoadTable2View(db As SQL, TableName As String, qryBox As TextArea, tblView As TableView) Try Dim t As List t = ExecuteMemoryTable(db, "PRAGMA table_info ('" & TableName & "')", Null, 0) Dim query As StringBuilder query.Initialize query.Append("SELECT ") For i = 0 To t.Size - 1 Dim values() As String values = t.Get(i) 't is a list of arrays query.Append("[").Append(values(1)).Append("]").Append(",") Next query.Remove(query.Length - 1, query.Length) 'remove last comma query.Append(" FROM ").Append(TableName) qryBox.Text = query.tostring ExecuteTableView(db,query.ToString,Null,500,tblView) Catch Log("LoadTable2View: " & LastException) End Try End Sub Sub CreateTableFromDefinition(jsql As SQL) 'create the table CreateTable(jsql, tbl2Create,tflds,tprikey,tauto) 'add the indexes AddIndexes(jsql,tbl2Create,tidxs) tbl2Create = "" tflds.Initialize tidxs.Initialize tprikey = "" tauto = "" End Sub Sub InitializeNewTable(tblName As String, sprikey As String, sauto As String) tbl2Create = tblName tflds.Initialize tidxs.Initialize tprikey = sprikey tauto = sauto If tauto.Length > 0 Then AddFieldOfInteger(sauto,True,True) End If End Sub Sub AddFieldOfInteger(fldName As String, isIndexed As Boolean, isunique As Boolean) tflds.Put(fldName, DB_INTEGER) If isIndexed = True Then tidxs.Put(fldName,isunique) End If End Sub Sub AddIndexedTextFields(fldNames As String) Dim spFields() As String = Regex.Split(",",fldNames) For Each strField As String In spFields strField = strField.trim If strField.Length > 0 Then AddFieldOfText(strField,True,False) Next End Sub Sub AddNormalTextFields(fldNames As String) Dim spFields() As String = Regex.Split(",",fldNames) For Each strField As String In spFields strField = strField.trim If strField.Length > 0 Then AddFieldOfText(strField,False,False) Next End Sub Sub AddFieldOfText(fldName As String, isIndexed As Boolean, isunique As Boolean) tflds.Put(fldName, DB_TEXT) If isIndexed = True Then tidxs.Put(fldName,isunique) End If End Sub Sub AddFieldOfReal(fldName As String, isIndexed As Boolean, isunique As Boolean) tflds.Put(fldName, DB_REAL) If isIndexed = True Then tidxs.Put(fldName,isunique) End If End Sub Sub AddFieldOfBlob(fldName As String, isIndexed As Boolean, isunique As Boolean) tflds.Put(fldName, DB_BLOB) If isIndexed = True Then tidxs.Put(fldName,isunique) End If End Sub Sub AddFieldOfNumeric(fldName As String, isIndexed As Boolean, isunique As Boolean) tflds.Put(fldName, DB_NUMERIC) If isIndexed = True Then tidxs.Put(fldName,isunique) End If End Sub Sub AddEditRecordWhere(jSQL As SQL,TableName As String, Fields As Map, WhereFields As Map) As Boolean Dim rExist As Boolean = SQLRecordExistsWhere(jSQL,TableName,WhereFields) 'Log(rExist) If rExist = False Then AddRecord(jSQL,TableName,Fields) Return SQLRecordExistsWhere(jSQL,TableName,WhereFields) Else Return SQLRecordUpdateWhere(jSQL,TableName,Fields,WhereFields) End If End Sub 'Update a mapped record and return true if successful Sub SQLRecordUpdateWhere(xSQL As SQL, TableName As String, Fields As Map, WhereFieldEquals As Map) As Boolean If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return False End If If Fields.Size = 0 Then Log("Fields empty") Return False End If Fields = DeDuplicateMap(Fields) WhereFieldEquals = DeDuplicateMap(WhereFieldEquals) Dim sb As StringBuilder xSQL.BeginTransaction Try sb.Initialize sb.Append("UPDATE ").Append(TableName).Append(" SET ") Dim args As List args.Initialize For i=0 To Fields.Size-1 If i<>Fields.Size-1 Then sb.Append(Fields.GetKeyAt(i)).Append("=?,") Else sb.Append(Fields.GetKeyAt(i)).Append("=?") End If args.Add(Fields.GetValueAt(i)) Next sb.Append(" WHERE ") For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") End If sb.Append(WhereFieldEquals.GetKeyAt(i)).Append(" = ?") args.Add(WhereFieldEquals.GetValueAt(i)) Next 'Log("SQLRecordUpdateWhere: " & sb.ToString) xSQL.ExecNonQuery2(sb.ToString, args) xSQL.TransactionSuccessful Return True Catch Log("SQLRecordUpdateWhere: " & LastException) xSQL.Rollback Return False End Try End Sub 'insert/update a record and read it Sub AddEditRecord(jsql As SQL, tblName As String, fldName As String, fldKey As String, flds As Map) As Map Dim recExist As Boolean = RecordExists(jsql,tblName,fldName, fldKey) If recExist = False Then ' the list does not exist, add it AddRecord(jsql,tblName,flds) Else RecordUpdate(jsql,tblName,flds,fldName,fldKey) End If Dim rec As Map = ReadRecord(jsql,tblName,fldName,fldKey) Return rec End Sub 'insert/update a record and read it Sub AddEditRecordOnly(jsql As SQL, tblName As String, fldName As String, fldKey As String, flds As Map) Dim recExist As Boolean = RecordExists(jsql,tblName,fldName, fldKey) If recExist = False Then ' the list does not exist, add it AddRecord(jsql,tblName,flds) Else RecordUpdate(jsql,tblName,flds,fldName,fldKey) End If End Sub 'insert and read a record back as a map Sub AddRecordRead(jsql As SQL, tblName As String,flds As Map) As Map Dim lr As Long = AddRecord(jsql,tblName,flds) Dim rec As Map = ReadRecord(jsql,tblName,"id",lr) Return rec End Sub 'insert and read a record Sub AddReadRecord(jsql As SQL, tblName As String,flds As Map) As Map Dim lr As Long = AddRecord(jsql,tblName,flds) Dim rec As Map = ReadRecord(jsql,tblName,"id",lr) Return rec End Sub 'update and read an existing record as a map Sub EditRecordRead(jsql As SQL, tblName As String, fldName As String, fldKey As String, flds As Map) As Map RecordUpdate(jsql,tblName,flds,fldName,fldKey) Dim rec As Map = ReadRecord(jsql,tblName,fldName,fldKey) Return rec End Sub 'update and read an existing record Sub EditReadRecord(jsql As SQL, tblName As String, fldName As String, fldKey As String, flds As Map) As Map RecordUpdate(jsql,tblName,flds,fldName,fldKey) Dim rec As Map = ReadRecord(jsql,tblName,fldName,fldKey) Return rec End Sub 'update and read an existing record Sub EditRecord(jsql As SQL, tblName As String, fldName As String, fldKey As String, flds As Map) RecordUpdate(jsql,tblName,flds,fldName,fldKey) End Sub Sub GetSQL() As SQL If UsePool Then Return pool.GetConnection Else Return SQLite End If End Sub Sub CloseSQL(mySQL As SQL) If UsePool Then mySQL.Close End If End Sub Sub InitializeSQLite(Dir As String, fileName As String, createIfNeeded As Boolean) As Int Try SQLite.InitializeSQLite(Dir, fileName, createIfNeeded) DatabaseType = 0 UsePool = False RanOK = True Catch Log("InitializeSQLite: "&LastException.Message) RanOK = False End Try End Sub Public Sub SetDefault(jSQL As SQL, TableName As String, FldName As String, Default As String) Dim qry As String qry = "update [" & TableName & "] set [" & FldName & "] = " & Default & " where [" & FldName & "] Is Null" RunQuery(jSQL, qry,True) qry = "update [" & TableName & "] set [" & FldName & "] = " & Default & " where [" & FldName & "] = ''" RunQuery(jSQL, qry,True) End Sub Public Sub SetDefault1(jSQL As SQL, TableName As String, defaultmap As Map) Dim qry As String For Each FldName As String In defaultmap.Keys Dim Default As String = defaultmap.Get(FldName) qry = "update [" & TableName & "] set [" & FldName & "] = " & Default & " where [" & FldName & "] Is Null" RunQuery(jSQL,qry,False) Next End Sub private Sub MySQLConnectionString(serverIP As String, serverPort As String, serverDB As String) As String Dim sb As StringBuilder sb.Initialize sb.Append("jdbc:mysql://").Append(serverIP).Append(":").Append(serverPort).Append("/").Append(serverDB) Return sb.tostring End Sub private Sub MSSQLConnectionString(serverIP As String, serverPort As String, serverDB As String) As String Dim sb As StringBuilder sb.Initialize sb.Append("jdbc:jtds:sqlserver://").Append(serverIP).Append(":").Append(serverPort).Append("/").Append(serverDB) Return sb.tostring End Sub 'jdbc:mysql://192.100.0.000:3306/DBname", "root", "root") Sub InitializeMySQL(serverIP As String, serverPort As String, serverDB As String, login As String, password As String, poolSize As Int) As Int DatabaseType = 1 UsePool = True Try Dim jdbcUrl As String jdbcUrl = MySQLConnectionString(serverIP,serverPort,serverDB) pool.Initialize("com.mysql.jdbc.Driver", jdbcUrl, login, password) RanOK = True Catch Log("InitializeMySQL: "&LastException.Message) RanOK = False End Try ' change pool size... Dim jo As JavaObject = pool jo.RunMethod("setMaxPoolSize", Array(poolSize)) End Sub Sub InitializeMSSQL(serverIP As String, serverPort As String, serverDB As String ,login As String, password As String, poolSize As Int) 'ignore DatabaseType = 2 Try Dim jdbcUrl As String jdbcUrl = MSSQLConnectionString(serverIP,serverPort,serverDB) pool.Initialize("net.sourceforge.jtds.jdbc.Driver", jdbcUrl, login, password) RanOK = True Catch Log("InitializeMSSQL: " & LastException.Message) RanOK = False End Try ' change pool size... Dim jo As JavaObject = pool jo.RunMethod("setMaxPoolSize", Array(poolSize)) End Sub 'Make db multiaccess Sub MakeMultiAccess(jSQL As SQL) RunQuery(jSQL,"PRAGMA journal_mode = wal",False) End Sub Private Sub EscapeField(f As String) As String Return $"[${f}]"$ End Sub private Sub MvFromList(lst As List, Delim As String) As String Dim lTot As Int Dim lCnt As Int Dim lStr As StringBuilder lStr.Initialize lTot = lst.Size - 1 For lCnt = 0 To lTot lStr.Append(lst.Get(lCnt)) If lCnt <> lTot Then lStr.Append(Delim) Next Return lStr.tostring End Sub private Sub Join(Delimiter As String, lst As List) As String Return MvFromList(lst,Delimiter) End Sub 'remove a delimiter from a string private Sub RemDelim(sValue As String, Delim As String) As String If sValue.EndsWith(Delim) Then Dim lDelim As Int = Delim.Length Dim nValue As String = sValue nValue = nValue.SubString2(0, nValue.Length-lDelim) Return nValue End If Return sValue End Sub 'get all column names from a table private Sub GetTableTextColumnNames(jsql As SQL, tblName As String) As List Dim strFld As String Dim fType As String Dim curFields As List Dim cur As ResultSet curFields.Initialize cur = jsql.ExecQuery("PRAGMA table_info ('" & tblName & "')") Do While cur.NextRow strFld = cur.GetString("name") fType = cur.GetString("type") If fType.ToLowerCase = "text" Then curFields.Add(strFld) Loop cur.close Return curFields End Sub 'get all column names from a table private Sub GetTableColumnNames(jsql As SQL, tblName As String) As List Dim strFld As String Dim curFields As List Dim cur As ResultSet curFields.Initialize cur = jsql.ExecQuery("PRAGMA table_info ('" & tblName & "')") Do While cur.NextRow strFld = cur.GetString("name") curFields.Add(strFld) Loop cur.close Return curFields End Sub 'gets the existance of a column from a table private Sub ColumnExists(jsql As SQL, tblName As String, colName As String) As Boolean Dim lst As List = GetTableColumnNames(jsql,tblName) If lst.IndexOf(colName) = -1 Then Return False Else Return True End If End Sub 'remove unwanted characters from sql command Sub CleanSQL(sValue As String) As String Dim sb As StringBuilder Dim tCnt As Int= 0 Dim tTot As Int = sValue.length - 1 Dim sIt As String Dim sTo As String = "01234567890)[abcdefghijklmnopqrstuvwxyz_,](" sb.Initialize For tCnt = 0 To tTot sIt = sValue.SubString2(tCnt,tCnt+1) Select Case sIt Case " " sb.Append(sIt) Case Else If sTo.IndexOf(sIt.ToLowerCase) >= 0 Then sb.Append(sIt) End If End Select Next Return sb.tostring End Sub 'remove a column from sqlite table, the fldname to remove is case sensitive Sub RemoveColumn1(jsql As SQL, TableName As String, FldName As String) As Boolean Dim isremoved As Boolean = False jsql.ExecNonQuery("PRAGMA foreign_keys=off;") jsql.BeginTransaction Try Dim newFields As List 'get the current table columns Dim curFields As List = GetTableColumnNames(jsql,TableName) 'remove the column to be removed from the list and define new column names Dim newFields As List newFields.Initialize For Each strColumn As String In curFields If strColumn.EqualsIgnoreCase(FldName) = False Then newFields.Add(strColumn) Next ' define the new fields to use in new table Dim newFieldsS As String = Join(",", newFields) 'get the sql that was used to create the original table Dim sqlS As String = jsql.ExecQuerySingleResult("SELECT sql from sqlite_master where name = '" & TableName & "'") 'clean the sql command to create the table sqlS = CleanSQL(sqlS) 'establish splitting locations sqlS = sqlS.Replace(",",",~") 'ensure the tabs are cleaned out sqlS = sqlS.Replace(TAB,"~") sqlS = sqlS.Replace(CRLF,"~") Dim spCode() As String = Regex.Split("~",sqlS) Dim sb As StringBuilder sb.Initialize For Each strLine As String In spCode ' see if line starts with column not needed If strLine.StartsWith("[" & FldName & "] ") = True Then ' do nothing else if strLine.StartsWith(FldName & " ") = True Then ' do nothing, this is precaution else If strLine.StartsWith(" [" & FldName & "] ") = True Then ' do nothing Else ' this should be used on a new table sb.Append(strLine) End If Next 'now rename the original table, we will copy records across jsql.ExecNonQuery("ALTER TABLE " & TableName & " RENAME TO " & TableName & "_old") 'create a new table with updated fields Dim sCommand As String = sb.ToString.trim If sCommand.EndsWith(",") = True Then sCommand = RemDelim(",",sCommand) sCommand = sCommand & ")" End If jsql.ExecNonQuery(sCommand) 'copy records to new table from renamed table jsql.ExecNonQuery("INSERT INTO " & TableName & "(" & newFieldsS & ") SELECT " & newFieldsS & " FROM " & TableName & "_old") ' drop the temporal table created jsql.ExecNonQuery("DROP TABLE " & TableName & "_old") isremoved = Not(ColumnExists(jsql, TableName, FldName)) jsql.TransactionSuccessful Catch jsql.Rollback Log("RemoveColumn: " & LastException) End Try jsql.ExecNonQuery("PRAGMA foreign_keys=on;") Return isremoved End Sub public Sub RemDelimSB(delimiter As String, value As StringBuilder) As StringBuilder If value.tostring.EndsWith(delimiter) = True Then Dim delimLen As Int = delimiter.length value.Remove(value.Length-delimLen,value.Length) End If Return value End Sub 'remove a column from sqlite table, the fldname to remove is case sensitive Sub RemoveColumn(jsql As SQL, TableName As String, FldName As String) As Boolean 'get the structure of the table Dim flds As Map = GetTableStructure(jsql,TableName) 'get the primary key Dim pkey As String = GetTablePrimaryKey(jsql,TableName) 'get the indexes of the table Dim idxs As Map = GetTableIndexes(jsql,TableName) 'remove the fldname to be deleted flds.Remove(FldName) flds.Remove(FldName.ToLowerCase) 'remove the indexes idxs.Remove(FldName) idxs.Remove(FldName.ToLowerCase) 'remove the old table DropTable(jsql,TableName & "_old") 'create a new table with the updated fields CreateTable(jsql,TableName & "_old",flds,pkey,pkey) 'add the indexes AddIndexes(jsql,TableName & "_old",idxs) 'get the new field names created Dim newFlds As StringBuilder newFlds.Initialize For Each strFld As String In flds.Keys newFlds.Append("[").Append(strFld).Append("],") Next newFlds = RemDelimSB(",",newFlds) 'copy the data from original to old table jsql.ExecNonQuery("PRAGMA foreign_keys=off;") jsql.BeginTransaction Try 'copy records to new table from original table jsql.ExecNonQuery("INSERT INTO [" & TableName & "_old] (" & newFlds & ") SELECT " & newFlds & " FROM [" & TableName & "]") ' drop the original table jsql.ExecNonQuery("DROP TABLE [" & TableName & "]") 'rename the old to new table jsql.ExecNonQuery("ALTER TABLE [" & TableName & "_old] RENAME TO [" & TableName & "]") jsql.TransactionSuccessful Catch jsql.Rollback Log("RemoveColumn: " & LastException) End Try 'just in case 'add the indexes AddIndexes(jsql,TableName,idxs) jsql.ExecNonQuery("PRAGMA foreign_keys=on;") 'does the column exists Return Not(ColumnExists(jsql,TableName,FldName)) End Sub ' return a list of the table column names as a list Sub GetFieldNames(jSQL As SQL,TableName As String) As List Dim res1 As List res1.Initialize Try Dim cur As ResultSet cur = jSQL.ExecQuery("PRAGMA table_info ('" & TableName & "')") Dim Table As List Table.Initialize Do While cur.NextRow res1.Add(cur.GetString("name").ToLowerCase) Loop cur.close Catch Log("GetFieldNames: " & LastException) End Try Return res1 End Sub Sub RenameTable(jSQL As SQL, prevTable As String, newTable As String) As Boolean If jSQL.IsInitialized = False Then Return False jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try jSQL.ExecNonQuery($"ALTER TABLE [${prevTable}] RENAME TO [${newTable}];"$) jSQL.TransactionSuccessful Catch jSQL.Rollback Log("RenameTable: " & LastException) End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") 'check if table exists Return TableExists(jSQL,newTable) End Sub Sub CloneTable1(jSQL As SQL, prevTable As String, newTable As String) As Boolean If jSQL.IsInitialized = False Then Return False jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try jSQL.ExecNonQuery($"CREATE TABLE [${newTable}] AS SELECT * FROM [${prevTable}];"$) jSQL.TransactionSuccessful Catch jSQL.Rollback Log("CloneTable: " & LastException) End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") 'check if table exists Return TableExists(jSQL,newTable) End Sub 'get the table structure from the pragma statement Sub GetTableStructure(jSQL As SQL, tblName As String) As Map Dim fld As Map fld.Initialize Dim fields As List = ExecuteMaps(jSQL,"PRAGMA table_info ('" & tblName & "')",Null) For Each fldm As Map In fields Dim fldname As String = fldm.GetDefault("name","") Dim fldtype As String = fldm.GetDefault("type","") fldname = fldname.tolowercase fld.put(fldname,fldtype) Next Return fld End Sub 'get the primary key of the table Sub GetTablePrimaryKey(jSQL As SQL, tblName As String) As String Dim fields As List = ExecuteMaps(jSQL,"PRAGMA table_info ('" & tblName & "')",Null) For Each fldm As Map In fields Dim fldname As String = fldm.GetDefault("name","") Dim fldpk As String = fldm.GetDefault("pk","") fldname = fldname.tolowercase If fldpk = "1" Then Return fldname Next Return "" End Sub 'get indexes of the table Sub GetTableIndexes(jSQL As SQL, tblName As String) As Map Dim fld As Map fld.initialize Dim fields As List = ExecuteMaps(jSQL, $"PRAGMA INDEX_LIST ('${tblName}')"$,Null) For Each fldm As Map In fields Dim fldname As String = fldm.GetDefault("name","") Dim unique As String = fldm.GetDefault("unique","") Dim bunique As Boolean = False If unique = "1" Then bunique = True 'go deeper and get the column names for this index Dim idxcols As List = ExecuteMaps(jSQL,$"PRAGMA index_info('${fldname}');"$,Null) For Each idxm As Map In idxcols fldname = idxm.GetDefault("name","") fld.Put(fldname,bunique) Next Next Return fld End Sub 'get indexes of the table Sub GetTableIndexesWithColumns(jSQL As SQL, tblName As String) As Map Dim fld As Map fld.initialize Dim fields As List = ExecuteMaps(jSQL, $"PRAGMA INDEX_LIST ('${tblName}')"$,Null) For Each fldm As Map In fields Dim fldname As String = fldm.GetDefault("name","") Dim unique As String = fldm.GetDefault("unique","") Dim bunique As Boolean = False If unique = "1" Then bunique = True 'go deeper and get the column names for this index Dim idxcols As List = ExecuteMaps(jSQL,$"PRAGMA index_info('${fldname}');"$,Null) Dim idxcolNames As List idxcolNames.Initialize For Each idxm As Map In idxcols Dim idxcolName As String = idxm.GetDefault("name","") idxcolNames.Add(idxcolName) Next Dim nidx As Map = CreateMap("unique":bunique,"columns":idxcolNames) fld.Put(fldname,nidx) Next Return fld End Sub Sub CloneTable(jSQL As SQL, prevTable As String, newTable As String) As Boolean 'get the structure of the table Dim flds As Map = GetTableStructure(jSQL,prevTable) 'get the primary key Dim pkey As String = GetTablePrimaryKey(jSQL,prevTable) 'get the indexes of the table Dim idxs As Map = GetTableIndexes(jSQL,prevTable) CreateTable(jSQL,newTable,flds,pkey,pkey) 'add the indexes AddIndexes(jSQL,newTable,idxs) Return TableExists(jSQL,newTable) End Sub ' return a list of the table column names as a list Sub GetIndexNames(jsQL As SQL,TableName As String) As List Dim res1 As List res1.Initialize Try Dim cur As ResultSet cur = jsQL.ExecQuery("PRAGMA INDEX_LIST ('" & TableName & "')") Dim Table As List Table.Initialize Do While cur.NextRow Dim m As Map m.Initialize m.Put("name", cur.GetString("name").ToLowerCase) m.Put("unique", cur.GetString("unique")) res1.Add(m) Loop cur.close Catch Log("GetIndexNames: " & LastException) End Try Return res1 End Sub ' return a list of the table index names and their column names Sub GetIndexNamesPlusColumns(jSQL As SQL,TableName As String) As List Dim res1 As List res1.Initialize Try Dim cur As ResultSet cur = jSQL.ExecQuery("select name,sql from sqlite_master where type='index' and tbl_name='" & TableName & "'") Dim table As List table.Initialize Do While cur.NextRow Dim sname As String = cur.GetString("name") Dim ssql As String = cur.GetString("sql") ssql = ssql.Replace("CREATE INDEX ","") ssql = ssql.Replace("\[" & TableName & "\]", "") ssql = ssql.Replace("ON ","") ssql = ssql.trim 'clean the sql Dim m As Map m.Initialize m.Put("name", sname) m.Put("columns", ssql) res1.Add(m) Loop cur.close Catch Log("GetIndexNamesPlusColumns: " & LastException) End Try Return res1 End Sub Sub FieldExist(jsQL As SQL, TableName As String, FldName As String) As Boolean FldName = FldName.tolowercase Dim xl As List xl = GetFieldNames(jsQL,TableName) If xl.IndexOf(FldName) = -1 Then Return False Else Return True End If End Sub Sub RunQuery1(jSQL As SQL, Qry As String, Args As List) 'Log("RunQuery1: " & Qry) Try jSQL.ExecNonQuery2(Qry, Args) RanOK = True Catch RanOK = False Log("RunQuery1: " & Qry) Log("RunQuery1: " & LastException) End Try End Sub ' check the existence of a table Sub FieldExists(jSQL As SQL,TableName As String, FldName As String) As Boolean FldName = FldName.ToLowerCase Dim lFld As List Dim lPos As Int lFld.Initialize lFld = GetFieldNames(jSQL,TableName) If lFld = Null Then Return False Else lPos = lFld.IndexOf(FldName) If lPos = -1 Then Return False Else Return True End If End If End Sub 'Description: Set all text fields to '' where they are null Sub TableSetTextFieldDetaults(jSQL As SQL, TableName As String) 'get all text fields Dim textFields As List = GetTableTextColumnNames(jSQL,TableName) For Each strField As String In textFields Dim qry As String = $"update [${TableName}] set [${strField}] = '' where [${strField}] isnull"$ jSQL.AddNonQueryToBatch(qry,Null) Next ExecuteBatch(jSQL) End Sub Sub AddColumnsList(jSQL As SQL, tablename As String, fldList As List) Dim nFields As Map nFields.Initialize For Each strField As String In fldList nFields.Put(strField,DB_TEXT) Next AddColumns(jSQL,tablename,nFields) End Sub ' update an existing table and add columns Sub AddColumns1(jSQL As SQL,TableName As String, FieldsAndTypes As Map) IsDone = False Dim fldTot As Int = 0 FieldsAndTypes = DeDuplicateMap(FieldsAndTypes) Dim ExistingColumns As List = GetFieldNames(jSQL,TableName) Dim i As Int For i = 0 To FieldsAndTypes.Size - 1 Dim sb, field, ftype As String field = FieldsAndTypes.GetKeyAt(i) ftype = FieldsAndTypes.GetValueAt(i) If field.Length > 0 And ftype.Length > 0 Then If ExistingColumns.IndexOf(field.tolowercase) = -1 Then sb = "ALTER TABLE [" & TableName & "] ADD COLUMN [" & field & "] " & ftype jSQL.AddNonQueryToBatch(sb,Null) fldTot = fldTot + 1 Select Case ftype Case DB_FLOAT, DB_INTEGER, DB_NUMERIC, DB_REAL sb = "UPDATE [" & TableName & "] SET [" & field & "] = 0" jSQL.AddNonQueryToBatch(sb,Null) fldTot = fldTot + 1 Case DB_TEXT sb = "UPDATE [" & TableName & "] SET [" & field & "] = ''" jSQL.AddNonQueryToBatch(sb,Null) fldTot = fldTot + 1 End Select End If End If Next If fldTot > 0 Then ExecuteBatch(jSQL) End If End Sub ' update an existing table and add columns Sub AddColumns(jSQL As SQL,TableName As String, FieldsAndTypes As Map) IsDone = False jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try FieldsAndTypes = DeDuplicateMap(FieldsAndTypes) Dim ExistingColumns As List = GetFieldNames(jSQL,TableName) Dim i As Int For i = 0 To FieldsAndTypes.Size - 1 Dim sb, field, ftype As String field = FieldsAndTypes.GetKeyAt(i) ftype = FieldsAndTypes.GetValueAt(i) If field.Length > 0 And ftype.Length > 0 Then If ExistingColumns.IndexOf(field.tolowercase) = -1 Then sb = "ALTER TABLE [" & TableName & "] ADD COLUMN [" & field & "] " & ftype jSQL.ExecNonQuery(sb) End If End If Next jSQL.TransactionSuccessful IsDone = True Catch jSQL.Rollback Log("AddColumns: " & LastException) IsDone = False End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") End Sub Sub SQL_NonQueryComplete (Success As Boolean) IsDone = True 'Log("NonQuery: " & Success) If Success = False Then Log("SQL_NonQueryComplete: " & LastException) End Sub 'executes a query and returns a result Sub RunQuery(jSQL As SQL, Qry As String, bUseTransaction As Boolean) If bUseTransaction = True Then jSQL.BeginTransaction End If Try 'Log("RunQuery: " & Qry) jSQL.ExecNonQuery(Qry) If bUseTransaction = True Then jSQL.TransactionSuccessful RanOK = True Catch If bUseTransaction = True Then jSQL.rollback RanOK = False Log("RunQuery: " & Qry) Log("RunQuery: " & LastException) End Try End Sub ' update an existing table and add columns Sub AddIndexes1(jSQL As SQL,TableName As String, Fields As Map) Dim i As Int Dim iadd As Int = 0 For i = 0 To Fields.Size - 1 Try iadd = iadd + 1 Dim sb As StringBuilder Dim field As String Dim unique As Boolean field = Fields.GetKeyAt(i) unique = Fields.GetValueAt(i) sb.Initialize sb.Append("CREATE ") If unique = True Then sb.Append("UNIQUE ") sb.Append("INDEX IF NOT EXISTS [").Append(TableName).Append(field).Append("]") sb.Append(" ON [").Append(TableName).Append("] ([").Append(field).Append("] COLLATE NOCASE)") jSQL.AddNonQueryToBatch(sb.tostring,Null) Catch Log("AddIndexes: " & LastException) End Try Next If iadd > 0 Then ExecuteBatch(jSQL) End If End Sub 'copy records from 1 table to another, existing records should match Sub CopyRecords(jSQL As SQL, sourceTable As String, targetTable As String) As Boolean Dim bOk As Boolean = False 'does the source have records Dim sourcecount As Int = jSQL.ExecQuerySingleResult($"SELECT count(*) from ${sourceTable}"$) If sourcecount = 0 Then Return True 'get field names from old table Dim newFields As List newFields.Initialize 'get the current table columns Dim oldFields As List = GetTableColumnNames(jSQL,sourceTable) 'get field names from new table Dim targetFields As List = GetTableColumnNames(jSQL,targetTable) 'extract only matching fields For Each strField As String In targetFields If OnList(oldFields,strField) = True Then newFields.Add(strField) End If Next Dim copyFields As String = Join(",", newFields) 'copy the data from original to old table jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try 'copy records to new table from original table jSQL.ExecNonQuery($"INSERT INTO ${targetTable} (${copyFields}) SELECT ${copyFields} FROM ${sourceTable};"$) jSQL.TransactionSuccessful 'count records on both Dim sourcecount As Int = jSQL.ExecQuerySingleResult($"SELECT count(*) from ${sourceTable}"$) Dim targetcount As Int = jSQL.ExecQuerySingleResult($"SELECT count(*) from ${targetTable}"$) If sourcecount = targetcount Then bOk = True Else bOk = False End If Catch jSQL.Rollback Log("CopyRecords: " & LastException) End Try 'just in case jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") Return bOk End Sub Sub OnList(searchList As List, searchValue As String) As Boolean 'If searchList.IsInitialized = False Then Return False For Each strTable As String In searchList If strTable.EqualsIgnoreCase(searchValue) = True Then Return True End If Next Return False End Sub ' update an existing table and add columns Sub AddIndexes(jSQL As SQL,TableName As String, FieldsAndTypes As Map) IsDone = False jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try FieldsAndTypes = DeDuplicateMap(FieldsAndTypes) Dim i As Int For i = 0 To FieldsAndTypes.Size - 1 Dim sb As StringBuilder Dim field As String Dim unique As Boolean field = FieldsAndTypes.GetKeyAt(i) unique = FieldsAndTypes.GetValueAt(i) If field.Length > 0 Then sb.Initialize sb.Append("CREATE ") If unique = True Then sb.Append("UNIQUE ") sb.Append("INDEX IF NOT EXISTS [").Append(TableName).Append(field).Append("]") sb.Append(" ON [").Append(TableName).Append("] ([").Append(field).Append("] COLLATE NOCASE)") jSQL.ExecNonQuery(sb.tostring) End If Next jSQL.TransactionSuccessful IsDone = True Catch jSQL.Rollback Log("AddIndexes: " & LastException) IsDone = False End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") End Sub Sub TableClear(jSQL As SQL, tblName As String) ClearTable(jSQL,tblName) End Sub ' clear table a table from a database Sub ClearTable(jSQL As SQL,TableName As String) RunQuery(jSQL,"DELETE FROM [" & TableName & "]",True) End Sub ' delete an index from a table Sub DropIndex(jSQL As SQL,TableName As String,IndexName As String) jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try Dim idxName As String idxName = TableName & IndexName RunQuery(jSQL, "DROP INDEX [IF EXISTS] [" & idxName & "]",False) jSQL.TransactionSuccessful Catch Log("DropIndex: " & LastException.Message) jSQL.Rollback End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") End Sub Sub RemoveIndexes(jSQL As SQL,TableName As String, idxList As List) IsDone = False jSQL.ExecNonQuery("PRAGMA foreign_keys=off;") jSQL.BeginTransaction Try For Each idxname As String In idxList idxname = TableName & idxname RunQuery(jSQL, "DROP INDEX [IF EXISTS] [" & idxname & "]",False) Next jSQL.TransactionSuccessful IsDone = True Catch jSQL.Rollback Log("RemoveIndexes: " & LastException) IsDone = False End Try jSQL.ExecNonQuery("PRAGMA foreign_keys=on;") 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(jSQL As SQL, TableName As String, FieldsAndTypes As Map, PrimaryKey As String, AutoIncrement As String) If TableExists(jSQL,TableName) = False Then Dim sb As StringBuilder sb.Initialize sb.Append("(") For i = 0 To FieldsAndTypes.Size - 1 Dim field, ftype As String field = FieldsAndTypes.GetKeyAt(i) ftype = FieldsAndTypes.GetValueAt(i) If i > 0 Then sb.Append(", ") sb.Append(EscapeField(field)).Append(" ").Append(ftype) If ftype = DB_TEXT Then sb.Append(" COLLATE NOCASE") If field.EqualsIgnoreCase(PrimaryKey) Then sb.Append(" NOT NULL PRIMARY KEY") If field.EqualsIgnoreCase(AutoIncrement) Then sb.Append(" AUTOINCREMENT") Next sb.Append(")") Dim query As String query = "CREATE TABLE IF NOT EXISTS " & EscapeField(TableName) & " " & sb.ToString RunQuery(jSQL,query,True) End If AddColumns(jSQL,TableName,FieldsAndTypes) End Sub 'Deletes the given table. Public Sub DropTable(jSQL As SQL, TableName As String) As Boolean Dim query As String query = "DROP TABLE IF EXISTS " & EscapeField(TableName) RunQuery(jSQL,query,True) Return Not(TableExists(jSQL,TableName)) End Sub 'Deletes the given trigger. Public Sub DropTrigger(jSQL As SQL, TableName As String) As Boolean jSQL.ExecNonQuery("DROP TRIGGER IF EXISTS " & TableName) Return Not(SQLiteTriggerExists(jSQL,TableName)) End Sub 'Delete a table Sub DeleteTable(jsql As SQL, tblName As String) As Boolean Return DropTable(jsql,tblName) End Sub public Sub RecordInsert(jSQL As SQL, TableName As String, nRecord As Map) As Long Return AddRecord(jSQL,TableName,nRecord) End Sub public Sub LastInsertID(jsql As SQL) As Long Dim res As Long = jsql.ExecQuerySingleResult("SELECT last_insert_rowid()") Return res End Sub public Sub LastRecordID(jsql As SQL, tblName As String, pk As String) As Long Dim res As Long = jsql.ExecQuerySingleResult("SELECT COUNT(" & pk & ") FROM " & tblName) If res = 0 Then Return 0 Else Dim res As Long = jsql.ExecQuerySingleResult("SELECT MAX(" & pk & ") FROM " & tblName) Return res End If End Sub public Sub RecordCount(jsql As SQL, tblName As String, pk As String) As Long Dim res As Long = jsql.ExecQuerySingleResult("SELECT COUNT(" & pk & ") FROM " & tblName) Return res End Sub public Sub RecordCountQry(jsql As SQL, tblQry As String) As Long Dim res As Long = jsql.ExecQuerySingleResult(tblQry) Return res End Sub 'insert a record and return its id public Sub AddRecord(jSQL As SQL, TableName As String, nRecord As Map) As Long Dim nList As List nList.Initialize nList.Add(nRecord) If InsertMaps(jSQL, TableName, nList,False) = True Then Dim lastrec As Long = LastInsertID(jSQL) Return lastrec Else Return -1 End If End Sub public Sub InsertMap(jSQL As SQL, TableName As String, Map2Insert As Map,bDebug As Boolean) As Boolean Dim ListOfMaps As List ListOfMaps.Initialize ListOfMaps.Add(Map2Insert) Return InsertMaps(jSQL,TableName,ListOfMaps,bDebug) 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(jSQL As SQL, TableName As String, ListOfMaps As List,bDebug As Boolean) As Boolean 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 False End If jSQL.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) m = DeDuplicateMap(m) For i2 = 0 To m.Size - 1 Dim col As String Dim value As Object col = m.GetKeyAt(i2) value = m.GetValueAt(i2) If i2 > 0 Then columns.Append(", ") values.Append(", ") End If columns.Append(EscapeField(col)) values.Append("?") listOfValues.Add(value) Next sb.Append(columns.ToString) sb.Append(") VALUES (") sb.Append(values.ToString) sb.Append(")") 'If i1 = 0 Then Log("InsertMaps (first query out of " & ListOfMaps.Size & "): " & sb.ToString) If bDebug = True Then Log(sb.ToString) Log(listOfValues) End If jSQL.ExecNonQuery2(sb.tostring, listOfValues) Next jSQL.TransactionSuccessful Return True Catch 'Log("InsertMaps: " & LastException) jSQL.Rollback Return False End Try 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 UpdateMaps(jSQL As SQL, TableName As String, ListOfMaps As List) As Boolean '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 False End If jSQL.BeginTransaction Try For i1 = 0 To ListOfMaps.Size - 1 Dim qrymap As Map = ListOfMaps.Get(i1) If qrymap.IsInitialized Then Dim qry As String = qrymap.Get("qry") Dim args As List = qrymap.Get("args") jSQL.ExecNonQuery2(qry, args) End If Next jSQL.TransactionSuccessful Return True Catch Log("UpdateMaps: " & LastException) jSQL.Rollback Return False End Try End Sub public Sub RecordUpdateField(jSQL As SQL, TableName As String, Field As String, NewValue As String, KeyField As String, KeyValue As String) Dim w As Map w.Initialize w.Put(KeyField,KeyValue) UpdateRecord(jSQL,TableName,Field,NewValue,w) End Sub ' updates a single field in a record ' Field is the column name Public Sub UpdateRecord(jSQL As SQL, TableName As String, Field As String, NewValue As Object, _ WhereFieldEquals As Map) WhereFieldEquals = DeDuplicateMap(WhereFieldEquals) Dim sb As StringBuilder 'jSQL.BeginTransaction Try sb.Initialize sb.Append("UPDATE ").Append(EscapeField(TableName)).Append(" SET ").Append(EscapeField(Field)) _ .Append(" = ? WHERE ") If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return End If Dim args As List args.Initialize args.Add(NewValue) For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") Dim sfield As String = WhereFieldEquals.GetKeyAt(i) sfield = $"lower(${sfield})"$ sb.Append(sfield).Append(" = ?") Dim sValue As String = WhereFieldEquals.GetValueAt(i) sValue = sValue.ToLowerCase args.Add(sValue) Next jSQL.ExecNonQuery2(sb.tostring, args) 'jSQL.TransactionSuccessful Catch Log("UpdateRecord: " & LastException) 'jSQL.Rollback End Try End Sub Sub RecordUpdateMap(TableName As String, fields As Map,PrimaryKey As String, PrimaryValue As String) As Map Return UpdateRecordMap(TableName,fields,CreateMap(PrimaryKey:PrimaryValue)) End Sub Sub RecordUpdate(jSQL As SQL, TableName As String, Fields As Map, PrimaryKey As String, PrimaryValue As String) Dim w As Map w.Initialize w.Put(PrimaryKey, PrimaryValue) UpdateRecord2(jSQL,TableName,Fields,w) End Sub Sub RecordsUpdateWhere(jSQL As SQL, TableName As String, Fields As Map, WhereFieldsEqual As Map) UpdateRecord2(jSQL,TableName,Fields,WhereFieldsEqual) End Sub ' updates multiple fields in a record ' in the Fields map the keys are the column names Public Sub UpdateRecord2(jSQL 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 Fields = DeDuplicateMap(Fields) WhereFieldEquals = DeDuplicateMap(WhereFieldEquals) Dim sb As StringBuilder 'jSQL.BeginTransaction Try sb.Initialize sb.Append("UPDATE ").Append(EscapeField(TableName)).Append(" SET ") Dim args As List args.Initialize For i=0 To Fields.Size-1 If i<>Fields.Size-1 Then sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?,") Else sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?") End If args.Add(Fields.GetValueAt(i)) Next sb.Append(" WHERE ") For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") End If Dim skey As String = WhereFieldEquals.GetKeyAt(i) skey = $"lower(${skey})"$ sb.Append(skey).Append(" = ?") Dim svalue As String = WhereFieldEquals.GetValueAt(i) svalue = svalue.ToLowerCase args.Add(svalue) Next jSQL.ExecNonQuery2(sb.tostring, args) 'jSQL.TransactionSuccessful Catch Log("UpdateRecord2: " & LastException) 'jSQL.Rollback End Try End Sub Public Sub UpdateRecordMap(TableName As String, Fields As Map, WhereFieldEquals As Map) As Map Dim out As Map If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return out End If If Fields.Size = 0 Then Log("Fields empty") Return out End If Fields = DeDuplicateMap(Fields) WhereFieldEquals = DeDuplicateMap(WhereFieldEquals) Dim sb As StringBuilder Try sb.Initialize sb.Append("UPDATE ").Append(EscapeField(TableName)).Append(" SET ") Dim args As List args.Initialize For i=0 To Fields.Size-1 If i<>Fields.Size-1 Then sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?,") Else sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?") End If args.Add(Fields.GetValueAt(i)) Next sb.Append(" WHERE ") For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") End If Dim skey As String = WhereFieldEquals.GetKeyAt(i) skey = $"lower(${skey})"$ sb.Append(skey).Append(" = ?") Dim svalue As String = WhereFieldEquals.GetValueAt(i) svalue = svalue.ToLowerCase args.Add(svalue) Next out = CreateMap("qry":sb.tostring,"args":args) Return out Catch Return out End Try End Sub 'description: use batch update methods 'tag: AddNonQueryToBatch, multiple updates Public Sub UpdateRecord4(jSQL 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 WhereFieldEquals = DeDuplicateMap(WhereFieldEquals) Dim sb As StringBuilder sb.Initialize sb.Append("UPDATE ").Append(TableName).Append(" SET ") Dim args As List args.Initialize For i=0 To Fields.Size-1 If i<>Fields.Size-1 Then sb.Append(Fields.GetKeyAt(i)).Append("=?,") Else sb.Append(Fields.GetKeyAt(i)).Append("=?") End If args.Add(Fields.GetValueAt(i)) Next sb.Append(" WHERE ") For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") End If Dim skey As String = WhereFieldEquals.GetKeyAt(i) skey = $"lower(${skey})"$ sb.Append(skey).Append(" = ?") Dim svalue As String = WhereFieldEquals.GetValueAt(i) svalue = svalue.ToLowerCase args.Add(svalue) Next jSQL.ExecNonQuery2(sb.ToString,args) End Sub 'Description: execute a batch for AddNonQueryToBatch 'Tags: wait for, ExecNonQueryBatch execute Sub ExecuteBatch(jSQL As SQL) Dim SenderFilter As Object = jSQL.ExecNonQueryBatch("SQL") Wait For (SenderFilter) SQL_NonQueryComplete (Success As Boolean) 'Log("NonQuery: " & Success) End Sub public Sub UpdateRecords(jSQL As SQL, TableName As String, KeyField As String, KeyValue As String) Dim w As Map w.Initialize w.Put(KeyField,KeyValue) UpdateRecord3(jSQL,TableName,w) End Sub Public Sub UpdateRecord3(jSQL As SQL, TableName As String, Fields As Map) If Fields.Size = 0 Then Log("Fields empty") Return End If Fields = DeDuplicateMap(Fields) Dim sb As StringBuilder jSQL.BeginTransaction Try sb.Initialize sb.Append("UPDATE ").Append(EscapeField(TableName)).Append(" SET ") Dim args As List args.Initialize For i=0 To Fields.Size-1 If i<>Fields.Size-1 Then sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?,") Else sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?") End If args.Add(Fields.GetValueAt(i)) Next jSQL.ExecNonQuery2(sb.tostring, args) jSQL.TransactionSuccessful Catch Log("UpdateRecord3: " & LastException) jSQL.Rollback End Try End Sub Sub Records2JSON(jSQL As SQL, TableName As String, Query As String) As String Dim records As List records = ExecuteMaps(jSQL, Query, Null) Dim root As Map root.Initialize root.Put("root", records) root.Put("table", TableName) Dim gen As JSONGenerator gen.Initialize(root) Dim outJSON As String outJSON = gen.ToString Return outJSON 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(jSQL As SQL, Query As String, StringArgs() As String, Limit As Int) As List Dim table As List table.Initialize Try Dim cur As ResultSet If StringArgs = Null Then Dim StringArgs(0) As String End If cur = jSQL.ExecQuery2(Query, StringArgs) Do While cur.NextRow Dim values(cur.ColumnCount) As String For col = 0 To cur.ColumnCount - 1 Dim fValue As String = cur.GetString2(col) fValue = FixNull(fValue) values(col) = fValue Next table.Add(values) If Limit > 0 And table.Size >= Limit Then Exit Loop cur.Close Return table Catch Log(Query) Log(StringArgs) Log("ExecuteMemoryTable: " & LastException) Return table End Try End Sub Sub CStr(o As Object) As String Return "" & o End Sub Sub FixNull(sObj As Object) As String Dim sValue As String If sObj = Null Then sValue = "" Else sValue = CStr(sObj) End If sValue = sValue.Replace("NULL","").Replace("null","") Return sValue 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 there are no results. Public Sub ExecuteMap(jSQL As SQL, Query As String, StringArgs() As String) As Map Dim res As Map Try Dim cur As ResultSet If StringArgs <> Null Then cur = jSQL.ExecQuery2(Query, StringArgs) Else cur = jSQL.ExecQuery(Query) End If If cur.NextRow = False Then 'Log("No records found.") Return res End If res.Initialize For i = 0 To cur.ColumnCount - 1 Dim fName As String = cur.GetColumnName(i).tolowercase Dim fValue As String = cur.GetString2(i) fValue = FixNull(fValue) res.Put(fName, fValue) Next cur.Close Catch Log(LastException) End Try Return res End Sub public Sub GetField(jSQL As SQL, TableName As String, PrimField As String, PrimValue As String, ReturnField As String) As String Dim mr As Map = ExecuteMap(jSQL, "SELECT [" & ReturnField & "] From [" & TableName & "] WHERE lower(" & PrimField & ") = ?", Array As String(PrimValue.tolowercase)) If mr.IsInitialized Then Dim sout As String = mr.Getdefault(ReturnField.tolowercase,"") Return sout Else Return "" End If End Sub public Sub RecordExists(jSQL As SQL, TableName As String, PrimField As String, PrimValue As String) As Boolean Dim mr As Map = ExecuteMap(jSQL, "SELECT [" & PrimField & "] From [" & TableName & "] WHERE lower(" & PrimField & ") = ?", Array As String(PrimValue.tolowercase)) If mr.IsInitialized = False Then Return False Else Return True End If End Sub Public Sub CountRecords(jSQL As SQL, TableName As String, PrimaryField As String, PrimaryValue As String) As Int Dim qry As String qry = $"SELECT Count(*) As Records From ${TableName} WHERE lower(${PrimaryField}) = ?"$ Dim mr As Map = ExecuteMap(jSQL, qry, Array As String(PrimaryValue.tolowercase)) If mr.IsInitialized = False Then Return 0 Else Return mr.Get("records") End If End Sub public Sub ExecuteQuery(jSQL As SQL, qry As String) Try jSQL.ExecNonQuery(qry) Catch Log("ExecuteQuery: " & qry & CRLF & LastException) End Try End Sub 'get a particular field contents from a table public Sub ExecuteField(jSQL As SQL, TableName As String, FieldName As String, bIncludeBlank As Boolean,bSort As Boolean) As List Dim lst As List = ExecuteMaps(jSQL,"select distinct [" & FieldName & "] from [" & TableName & "] order by [" & FieldName & "]",Null) Dim lstCnt As Int Dim lstTot As Int Dim lstMap As Map Dim lstStr As String Dim lstOut As List lstOut.Initialize lstTot = lst.Size - 1 For lstCnt = 0 To lstTot lstMap = lst.Get(lstCnt) lstStr = lstMap.Get(FieldName.ToLowerCase) lstOut.Add(lstStr) Next If bIncludeBlank = True Then lstOut.Add("") End If If bSort = True Then lstOut.Sort(True) Return lstOut End Sub public Sub ExecuteField1(jSQL As SQL, Qry As String, FieldName As String, bIncludeBlank As Boolean,bSort As Boolean) As List Dim lst As List = ExecuteMaps(jSQL, Qry, Null) Dim lstCnt As Int Dim lstTot As Int Dim lstMap As Map Dim lstStr As String Dim lstOut As List lstOut.Initialize lstTot = lst.Size - 1 For lstCnt = 0 To lstTot lstMap = lst.Get(lstCnt) lstStr = lstMap.Get(FieldName.ToLowerCase) lstOut.Add(lstStr) Next If bIncludeBlank = True Then lstOut.Add("") End If If bSort = True Then lstOut.Sort(True) Return lstOut End Sub public Sub NextCount1(jSQL As SQL, TableName As String, PrimaryKey As String) As String 'The SQLite coalesce function returns the first non-null expression in the list. Dim ll As List ll = ExecuteMemoryTable(jSQL, "select coalesce(max(" & PrimaryKey & "),0) as records from " & TableName,Null,1) Dim Cols() As String Cols = ll.Get(0) Return Cols(0) End Sub ' get the next available record based on this key public Sub NextAvailable(jSQL As SQL, TableName As String, PrimaryKey As String, PrimaryValue As String) As String Dim bExist As Boolean Dim mainKey As String Dim counter As Int mainKey = PrimaryValue bExist = RecordExists(jSQL,TableName,PrimaryKey,PrimaryValue) If bExist = False Then Return mainKey Else Do Until bExist = False counter = counter + 1 PrimaryValue = mainKey & counter bExist = RecordExists(jSQL,TableName,PrimaryKey,PrimaryValue) Loop Return PrimaryValue End If End Sub Public Sub ExecuteMaps(jSQL As SQL, Query As String, StringArgs() As String) As List If Query.trim.ToLowerCase.StartsWith("select ") Then else If Query.trim.ToLowerCase.StartsWith("pragma ") Then else If Query.trim.ToLowerCase.StartsWith("show ") Then else If Query.trim.ToLowerCase.StartsWith("describe ") Then else If Query.trim.ToLowerCase.StartsWith("insert ") Then else If Query.trim.ToLowerCase.StartsWith("update ") Then else If Query.trim.ToLowerCase.StartsWith("delete ") Then Else Query = $"select * from ${Query}"$ End If Dim lst As List lst.Initialize Try Dim res As Map Dim cur As ResultSet If StringArgs <> Null Then cur = jSQL.ExecQuery2(Query, StringArgs) Else cur = jSQL.ExecQuery(Query) End If Do While cur.NextRow res.Initialize For i = 0 To cur.ColumnCount - 1 Dim fValue As String = cur.GetString2(i) fValue = FixNull(fValue) res.Put(cur.GetColumnName(i).ToLowerCase, fValue) Next lst.Add(res) Loop cur.Close Return lst Catch Log(Query) Log("ExecuteMaps: " & LastException.Message) Return lst End Try End Sub private Sub ListOfMaps2JSON(lst As List) As String Dim sOut As String Dim jsonGen As JSONGenerator jsonGen.Initialize2(lst) sOut = jsonGen.ToString Return sOut End Sub Public Sub TableRecords2Maps(jSQL As SQL, tblName As String) As List Return ExecuteMaps(jSQL,"select * from " & tblName,Null) End Sub public Sub TableRecords2JSON(jSQL As SQL, tblName As String) As String Dim lst As List = TableRecords2Maps(jSQL,tblName) Dim json As String = ListOfMaps2JSON(lst) Return json End Sub public Sub TableRecords2JSONWhere(jSQL As SQL, tblName As String, w As Map) As String Dim tbl As StringBuilder Dim args As List args.initialize tbl.initialize tbl.Append($"select * from ${tblName} WHERE "$) For i = 0 To w.Size - 1 If i > 0 Then tbl.Append(" AND ") End If tbl.Append(w.GetKeyAt(i)).Append(" = ?") args.Add(w.GetValueAt(i)) Next Dim lst As List = ExecuteMapsWhere(jSQL,tbl.tostring,args) Dim json As String = ListOfMaps2JSON(lst) Return json End Sub Public Sub SQLExecuteMaps(jSQL As SQL, Query As String, StringArgs() As String) As List Dim lst As List lst.Initialize Try Dim res As Map Dim cur As ResultSet If StringArgs <> Null Then cur = jSQL.ExecQuery2(Query, StringArgs) Else cur = jSQL.ExecQuery(Query) End If Do While cur.NextRow res.Initialize For i = 0 To cur.ColumnCount - 1 Dim fValue As String = cur.GetString2(i) fValue = FixNull(fValue) res.Put(cur.GetColumnName(i).ToLowerCase, fValue) Next lst.Add(res) Loop cur.Close Catch Log("SQLExecuteMaps: " & LastException.Message) End Try Return lst End Sub 'Executes the query and fills the list with the values in the first column. Public Sub ExecuteList(jSQL As SQL, Query As String, StringArgs() As String, Limit As Int, List1 As List) If List1.IsInitialized = False Then List1.Initialize List1.clear Dim Table As List Table = ExecuteMemoryTable(jSQL, Query, StringArgs, Limit) If Table.Size = 0 Then Return Dim Cols() As String For i = 0 To Table.Size - 1 Cols = Table.Get(i) List1.Add(Cols(0)) Next End Sub Public Sub ExecuteTableView(jSQL As SQL, Query As String, StringArgs() As String, Limit As Int, TableView1 As TableView) As Boolean Try Dim cur As ResultSet If StringArgs = Null Then Dim StringArgs(0) As String End If cur = jSQL.ExecQuery2(Query, StringArgs) Dim cols As List cols.Initialize For i = 0 To cur.ColumnCount - 1 cols.Add(cur.GetColumnName(i)) Next TableView1.SetColumns(cols) TableView1.Items.clear Do While cur.NextRow Dim values(cur.ColumnCount) As String For col = 0 To cur.ColumnCount - 1 Dim fValue As String = cur.GetString2(col) fValue = FixNull(fValue) values(col) = fValue Next TableView1.Items.Add(values) If Limit > 0 And TableView1.Items.Size >= Limit Then Exit Loop cur.Close Return True Catch Return False End Try End Sub Public Sub GetFieldNamesFromQuery(jSQL As SQL, Query As String, StringArgs() As String) As String Dim sb As StringBuilder sb.Initialize Try Dim cur As ResultSet If StringArgs = Null Then Dim StringArgs(0) As String End If cur = jSQL.ExecQuery2(Query, StringArgs) Dim cols As List cols.Initialize For i = 0 To cur.ColumnCount - 1 sb.Append(cur.GetColumnName(i)).Append(",") Next sb.Remove(sb.Length-1,sb.Length) cur.Close Return sb.tostring Catch Return "" End Try End Sub Sub ReadField(jSQL As SQL, tablename As String, PrimaryKey As String, PrimaryValue As String, Field As String) As String Dim rec As Map = ReadRecord(jSQL,tablename,PrimaryKey,PrimaryValue) If rec.IsInitialized Then Field = Field.ToLowerCase Return rec.GetDefault(Field,"") Else Return "" End If End Sub Sub RecordRead(jSQL As SQL, tablename As String, PrimaryKey As String, PrimaryValue As String) As Map Return ReadRecord(jSQL,tablename,PrimaryKey,PrimaryValue) End Sub Sub ReadRecord(jSQL As SQL, TableName As String, PrimaryKey As String, PrimaryValue As String) As Map Return ExecuteMap(jSQL, "SELECT * FROM [" & TableName & "] WHERE lower(" & PrimaryKey & ") = ?", Array As String(PrimaryValue.tolowercase)) End Sub public Sub RecordDelete(jSQL As SQL, TableName As String, KeyField As String, KeyValue As String) As Boolean DeleteRecord(jSQL,TableName,KeyField,KeyValue) Return Not(RecordExists(jSQL,TableName,KeyField,KeyValue)) End Sub public Sub DeleteRecord(jSQL As SQL, TableName As String, KeyField As String, KeyValue As String) Dim w As Map w.Initialize w.Put(KeyField,KeyValue) DeleteRecordWhere(jSQL,TableName,w,True) End Sub Sub RecordDeleteWhere(jSQL As SQL, TableName As String, WhereFieldsEqual As Map) DeleteRecordWhere(jSQL, TableName, WhereFieldsEqual,True) End Sub 'Description: Count records where 'Tag: count records Public Sub CountRecordsWhere(jSQL As SQL, TableName As String,Field As String, WhereFieldEquals As Map) As Int If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return 0 End If Dim sb As StringBuilder sb.Initialize sb.Append($"SELECT Count(${Field}) As records From [${TableName}] WHERE "$) Dim args As List args.Initialize For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") Dim skey As String = WhereFieldEquals.GetKeyAt(i) skey = $"lower(${skey})"$ sb.Append(skey).Append(" = ?") Dim svalue As String = WhereFieldEquals.GetValueAt(i) svalue = svalue.ToLowerCase args.Add(svalue) Next Dim intRes As Int = jSQL.ExecQuerySingleResult2(sb.ToString,args) Return intRes End Sub Public Sub DeleteRecordWhere(jSQL As SQL, TableName As String, WhereFieldEquals As Map, bUseTransaction As Boolean) 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 For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") sb.Append("lower(").Append(WhereFieldEquals.GetKeyAt(i)).Append(") = ?") Dim svalue As String = WhereFieldEquals.GetValueAt(i) svalue = svalue.ToLowerCase args.Add(svalue) Next If bUseTransaction = True Then jSQL.BeginTransaction jSQL.ExecNonQuery2(sb.tostring, args) If bUseTransaction = True Then jSQL.TransactionSuccessful End Sub Private Sub List2Array (a_lstArgs As List) As String() Dim arrArgs(a_lstArgs.Size) As String For i = 0 To arrArgs.Length - 1 arrArgs(i) = a_lstArgs.Get(i) Next Return arrArgs End Sub Public Sub SQLSelectRecordWhereMap(jSQL As SQL, TableName As String, WhereFieldEquals As Map) As Map Dim lst As Map Dim sb As StringBuilder sb.Initialize sb.Append("SELECT * FROM ").Append(TableName).Append(" WHERE ") If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return lst End If Dim args As List args.Initialize For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") Dim sKey As String = WhereFieldEquals.GetKeyAt(i) sKey = sKey.trim If sKey.EndsWith(">") Or sKey.EndsWith(">=") Or sKey.EndsWith("=") Or sKey.EndsWith("<") Or sKey.endswith("<>") Or sKey.EndsWith("<=") Then sKey = "" Else sKey = "=" End If sb.Append(WhereFieldEquals.GetKeyAt(i)).Append(sKey).Append(" ?") args.Add(WhereFieldEquals.GetValueAt(i)) Next Return ExecuteMap(jSQL,sb.ToString, List2Array(args)) End Sub Sub SQLRecordExistsWhere(jSQL As SQL, TableName As String, WhereFieldEquals As Map) As Boolean Dim mr As Map = SQLSelectRecordWhereMap(jSQL, TableName,WhereFieldEquals) If mr.IsInitialized = False Then Return False Else Return True End If End Sub Public Sub SQLSelectRecordWhereMaps(jSQL As SQL, TableName As String, WhereFieldEquals As Map, OrderBy As String) As List Dim lst As List lst.Initialize Dim sb As StringBuilder sb.Initialize If TableName.ToLowerCase.StartsWith("select ") Then sb.Append(TableName).Append(" WHERE ") Else sb.Append("SELECT * FROM ").Append(TableName).Append(" WHERE ") End If If WhereFieldEquals.Size = 0 Then Log("WhereFieldEquals map empty!") Return lst End If Dim args As List args.Initialize For i = 0 To WhereFieldEquals.Size - 1 If i > 0 Then sb.Append(" AND ") Dim sKey As String = WhereFieldEquals.GetKeyAt(i) sKey = sKey.Trim If sKey.EndsWith(">") Or sKey.EndsWith(">=") Or sKey.EndsWith("=") Or sKey.EndsWith("<") Or sKey.endswith("<>") Or sKey.EndsWith("<=") Then sKey = "" Else sKey = "=" End If sb.Append(WhereFieldEquals.GetKeyAt(i)).Append(sKey).Append(" ?") args.Add(WhereFieldEquals.GetValueAt(i)) Next If OrderBy.Length > 0 Then sb.append($" ORDER BY ${OrderBy}"$) Return ExecuteMaps(jSQL,sb.ToString, List2Array(args)) End Sub Public Sub ExecuteMapsWhere(jsql As SQL, sqlQuery As String, wl As List) As List Return ExecuteMaps(jsql,sqlQuery, List2Array(wl)) End Sub Sub GetSQLiteTableNames(jSQL As SQL) As List Dim xy As List xy.Initialize ExecuteList(jSQL,"select tbl_name from sqlite_master where type = 'table' and tbl_name NOT IN ('sqlite_sequence') order by lower(tbl_name)",Null,0,xy) Return xy End Sub Sub ListRemoveItem(lst As List, item As String) Dim lPos As Int = lst.IndexOf(item) If lPos <> -1 Then lst.RemoveAt(lPos) End Sub Sub TableExists(jSQL As SQL, tblName As String) As Boolean Return SQLiteTableExists(jSQL, tblName) End Sub Sub TableNames(jSQL As SQL) As List Return GetSQLiteTableNames(jSQL) End Sub Sub SQLiteTableExists1(jsql As SQL, tblName As String) As Boolean Dim xy As List = GetSQLiteTableNames(jsql) For Each strTable As String In xy If strTable.EqualsIgnoreCase(tblName) = True Then Return True End If Next Return False End Sub Sub ReplaceAll(Text As String, Pattern As String, Replacement As String) As String Dim jo As JavaObject = Regex.Matcher(Pattern, Text) Return jo.RunMethod("replaceAll", Array(Replacement)) End Sub Sub DeDuplicateMap(oldMap As Map) As Map Dim nMap As Map Dim strValue As Object nMap.Initialize For Each strKey As String In oldMap.Keys strValue = oldMap.Get(strKey) strKey = strKey.ToLowerCase If strKey <> "null" Then nMap.Put(strKey,strValue) Next Return nMap End Sub Sub SQLiteResetCounter(jSQL As SQL, tblName As String, id As String) jSQL.BeginTransaction Try 'get the last max on the table Dim lastmax As String = jSQL.ExecQuerySingleResult2($"SELECT MAX(${id}) FROM ${tblName}"$, Null) If lastmax = Null Then lastmax = 0 'reset the counter to lastmax jSQL.ExecNonQuery($"UPDATE SQLITE_SEQUENCE SET SEQ=${lastmax} WHERE NAME='${tblName}'"$) jSQL.TransactionSuccessful Catch Log("SQLiteResetCounter: " & LastException) jSQL.Rollback End Try End Sub Sub InsertFile(sql As SQL, tablename As String, fldname As String, dir As String, filename As String) 'convert the image file to a bytes array Dim InputStream1 As InputStream InputStream1 = File.OpenInput(dir, filename) Dim OutputStream1 As OutputStream OutputStream1.InitializeToBytesArray(1000) File.Copy2(InputStream1, OutputStream1) Dim Buffer() As Byte 'declares an empty array Buffer = OutputStream1.ToBytesArray 'write the image to the database 'sql.ExecNonQuery2("INSERT INTO " & tablename & " VALUES('smiley', ?)", Array As Object(Buffer)) End Sub