B4J Code Snippet Sharing the goodness: Useful methods

Discussion in 'B4J Code Snippets' started by Mashiane, Oct 6, 2015.

  1. Mashiane

    Mashiane Well-Known Member Licensed User

    The purpose of this snippet is to remove a column from a SQLite database via code. This is part 1 of this code as the indexes are not taken care of except the primary key.

    Usage:

    Code:
    Dim colExist As Boolean = RemoveColumn(sql"MyTable""MyFieldName")
    if colExist = True then
    Log("column removed")
    else
    log("Column could not be removed")
    end If
    Here is the rest of the snippets making this work...

    Code:
    ' return a delimited string from a list
    private Sub Join(Delimiter, lst As ListAs String
        
    Dim lStr As StringBuilder
        lStr.Initialize
        
    For Each strValue As String In lst
            lStr.Append(strValue).Append(Delimiter)
        
    Next
        
    Return RemDelim(Delimiter,lStr.tostring)
    End Sub


    'remove a delimiter from a string
    private Sub RemDelim(delimiter As String, value As StringAs String
        
    If value.EndsWith(delimiter) = True Then
            
    Dim delimLen As Int = delimiter.length
            
    Dim sb As StringBuilder
            sb.Initialize
            sb.Append(value)
            sb.Remove(sb.Length-delimLen,sb.Length)
            
    Return sb.tostring
        
    Else
            
    Return value
        
    End If
    End Sub

    'get all column names from a table
    private Sub GetTableColumnNames(sql As SQL, tblName As StringAs List
        
    Dim strFld As String
        
    Dim curFields As List
        
    Dim cur As ResultSet
        curFields.Initialize   
        cur = 
    sql.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(sql As SQL, tblName As String, colName As StringAs Boolean
        
    Dim lst As List = GetTableColumnNames(sql,tblName)
        
    If lst.IndexOf(colName) = -1 Then
            
    Return False
        
    Else
            
    Return True
        
    End If
    End Sub

    'remove unwanted characters from sql command
    Private Sub CleanSQL(sValue As StringAs 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 RemoveColumn(sql As SQL, TableName As String, FldName As StringAs Boolean
        
    Dim isremoved As Boolean = False
        
    sql.BeginTransaction
        
    Try
            
    Dim newFields As List
            
    'get the current table columns
            Dim curFields As List = GetTableColumnNames(sql,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 = sql.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
            sql.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
            
    sql.ExecNonQuery(sCommand)
            
            
    'copy records to new table from renamed table
            sql.ExecNonQuery("INSERT INTO " & TableName & "(" & newFieldsS & ") SELECT " & newFieldsS & " FROM " & TableName & "_old")
            
    ' drop the temporal table created
            sql.ExecNonQuery("DROP TABLE " & TableName & "_old")
            isremoved = 
    Not(ColumnExists(sql, TableName, FldName))
            
    sql.TransactionSuccessful
        
    Catch
            
    sql.Rollback
            
    Log(LastException)
        
    End Try
        
    Return isremoved
    End Sub
     
    Last edited: Jan 12, 2017
    joulongleu likes this.
  2. Mashiane

    Mashiane Well-Known Member Licensed User

    I wanted to have my statusbar to have FontAwesome icons instead of text..

    Code:
    Sub CreateStatusBar
        
    'add the status bar at the bottom
        StatusBar1.Text = "Conceptualized, Designed and Developed by Anele 'Mashy' Mbanga - anele@mbangas.com"
        
    'StatusBar1.Progress = 0.5
        'btnPreview.Initialize("btnPreview")
        'btnPreview.Text = "Preview Source Code"
        'btnPreview.Enabled = False
        btnFullScreen.Initialize("btnFullScreen")
        btnFullScreen.Text = 
    "Full Screen"
        btnFullScreen.Enabled = 
    True
        btnSnap.Initialize(
    "btnSnap")
        btnSnap.Text = 
    "Snap"
        btnSnap.Enabled = 
    True
        
    'use font awesome
        btnFullScreen.Font = awesome
           btnFullScreen.Text = 
    ""
        btnSnap.Font = awesome
        btnSnap.text = 
    ""
        
    'Dim sep1 As Separator
        'sep1.Initialize("")
        StatusBar1.RightItems.AddAll(Array(btnFullScreen,btnSnap))
    End Sub
    So I downloaded the FontAwesome.otf and added it via the Files tab to my B4J project, and copied the icons I wanted to use from Here is a cheatsheet: http://fontawesome.io/cheatsheet/

    In Process_Globals added..

    Code:
    Private awesome As Font
    In AppStart added...

    Code:
    awesome = fx.LoadFont(File.DirAssets, "FontAwesome.otf"20)
     
  3. Mashiane

    Mashiane Well-Known Member Licensed User

    'Description: Reset the auto-increment counter to the max available rowid in a sqlite table
    'Tag: sqlite, auto-increment, set
    Code:
    Sub SQLiteResetCounter(jSQL As SQL, tblName As Stringid 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 lastmax value
            jSQL.ExecNonQuery($"UPDATE SQLITE_SEQUENCE SET SEQ=${lastmax} WHERE NAME='${tblName}'"$
           jSQL.TransactionSuccessful  
        
    Catch
            
    Log("SQLiteResetCounter: " & LastException)
        jSQL.Rollback
        
    End Try
    End Sub
     
    JakeBullet70 likes this.
  4. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: set the page of a TabPage in a TabPane
    'tag: tabpane, tagpage
    Sub TabPageSetText(tbPane As TabPane, idx As Int, Text As String)
        
    Dim tbPageList As List = tbPane.Tabs
        
    Dim tbPage As TabPage = tbPageList.Get(idx)
        tbPage.Text = Text
    End Sub
     
    Last edited: May 19, 2017
  5. Mashiane

    Mashiane Well-Known Member Licensed User

    'Description: Get a delimited string of values checked in a CheckComboBox control
    'Tag: CheckComboBox values
    Code:
    Sub GetCheckedValues(cbc As CheckComboBox) As String
        
    Dim sb As StringBuilder
        sb.Initialize
        
    For Each index As Int In cbc.GetCheckedIndices
            
    Dim cvalue As String = cbc.items.Get(index)
            sb.Append(cvalue).Append(
    ",")
        
    Next
        
    If sb.ToString.EndsWith(","Then
            sb.Remove(sb.Length-
    1,sb.Length)
        
    End If
        
    Return sb.tostring
    End Sub
     
  6. Mashiane

    Mashiane Well-Known Member Licensed User

    'Description: Set checked values in a CheckComboBox control from a delimited string
    'Tag: CheckComboBox values

    Code:
    private Sub SetCheckedValues(cbc As CheckComboBox, cv As String)
        
    'split the items to check
        Dim spItems() As String = Regex.Split(",",cv)
        
    'get the list of existing items
        Dim existingItems As List = cbc.Items
        
    'loop through each item to add and then check it
        For Each strItem As String In spItems
            
    Dim idx As Int = existingItems.IndexOf(strItem)
            
    If idx <> -1 Then
                cbc.SetChecked(idx,
    True)
            
    End If
        
    Next
    End Sub
     
  7. Harris

    Harris Well-Known Member Licensed User

    What is this?

    Where did you create a cbc?

    Did you add ABMCheckbox to a ABMCombo or a ABMList?

    How does this determine it's State? - for each item?

    Wee bit confused... All strange to me...
     
  8. alwaysbusy

    alwaysbusy Well-Known Member Licensed User

    This is not for ABMaterial, but for a B4J javaFx combo I think
     
  9. giga

    giga Well-Known Member Licensed User

    Nice share! I am sure many will find these useful.
     
    Mashiane likes this.
  10. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: return all keys containing text like
    'tag: key value store, keys
    Public Sub ListKeysLike(sLike As StringAs List
        
    Dim c As ResultSet = sql1.ExecQuery("SELECT key FROM main where key LIKE '%" & sLike & "%' order by key")
        
    Dim res As List
        res.Initialize
        
    Do While c.NextRow
            res.Add(c.GetString2(
    0))
        
    Loop
        c.Close
        
    Return res
    End Sub

    'Description: return all keys starting with text like
    'tag: key value store, keys
    Public Sub ListKeysStartsWith(sLike As StringAs List
        
    Dim c As ResultSet = sql1.ExecQuery("SELECT key FROM main where key LIKE '" & sLike & "%' order by key")
        
    Dim res As List
        res.Initialize
        
    Do While c.NextRow
            res.Add(c.GetString2(
    0))
        
    Loop
        c.Close
        
    Return res
    End Sub
     
    Last edited: Oct 1, 2017
    JakeBullet70 likes this.
  11. Erel

    Erel Administrator Staff Member Licensed User

    You should close the ResultSets before you return from these subs.
     
    Mashiane likes this.
  12. alwaysbusy

    alwaysbusy Well-Known Member Licensed User

    and probably better use ExecQuery2 in case there are quotes in the sLike
     
    Erel and Mashiane like this.
  13. Mashiane

    Mashiane Well-Known Member Licensed User

    Noted that I'm still using kvs 1.01, did the updates, thanks a lot!
     
  14. Mashiane

    Mashiane Well-Known Member Licensed User

    Definately, thanks...
     
  15. Mashiane

    Mashiane Well-Known Member Licensed User

    I wanted a quick way to execute multiple updates to my database using a where clause (defined with a map)

    Code:
    '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(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
            sb.Append(EscapeField(WhereFieldEquals.GetKeyAt(i))).Append(
    " = ?")
            args.Add(WhereFieldEquals.GetValueAt(i))
        
    Next
        jSQL.AddNonQueryToBatch(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
    Usage: call multiple UpdateRecord4

    ....
    DbUtils.UpdateRecord4()
    DbUtils.UpdateRecord4()
    DbUtils.UpdateRecord4()
    DbUtils.UpdateRecord4()

    then

    DbUtils.ExecuteBatch() passing the database name

    I have added this to my DBUtils.
     
    Harris likes this.
  16. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: Count records where using a map of fields that match
    'Tag: count records
    Public Sub CountRecordsWhere(jSQL As SQL, TableName As String,Field As String, WhereFieldEquals As MapAs 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 ")
            sb.Append(EscapeField(WhereFieldEquals.GetKeyAt(i)))
            sb.Append(
    " = ?")
            args.Add(WhereFieldEquals.GetValueAt(i))
        
    Next
        
    Dim intRes As Int = jSQL.ExecQuerySingleResult2(sb.ToString,args)
        
    Return intRes
    End Sub
     
    inakigarm likes this.
  17. Mashiane

    Mashiane Well-Known Member Licensed User

    Some menu item hiding / enabling code.

    Code:
    'Description: Set the menuItem to visible true/false
    'Tag: MenuItem, hide, visibility
    'Usage: MenuItemVisible(MenuBar1,"File","Copy",False) - will hide the Copy Menu Item in the File menu
    Sub MenuItemVisible(MBar As MenuBar, MainMenu As StringMenuItem As String, bVisible As Boolean)
        
    Dim lMenus As List = MBar.menus
        
    For Each strMenu As Menu In lMenus
            
    Dim mText As String = strMenu.text
            
    If mText.EqualsIgnoreCase(MainMenu) Then
                
    For Each mi As MenuItem In strMenu.MenuItems
                    
    Dim miText As String = mi.Text
                    
    If miText.EqualsIgnoreCase(MenuItemThen
                        mi.Visible = bVisible
                        
    Return
                    
    End If
                
    Next
            
    End If
        
    Next
    End Sub

    'Description: Set the menuItem image
    'Tag: MenuItem, image
    'Usage: MenuItemSetImage(MenuBar1,"File","Copy",File.DirAssets,"copy.png")
    Sub MenuItemSetImage(MBar As MenuBar, MainMenu As StringMenuItem As String, Dir As String, ImageName As String)
        
    Dim lMenus As List = MBar.menus
        
    For Each strMenu As Menu In lMenus
            
    Dim mText As String = strMenu.text
            
    If mText.EqualsIgnoreCase(MainMenu) Then
                
    For Each mi As MenuItem In strMenu.MenuItems
                    
    Dim miText As String = mi.Text
                    
    If miText.EqualsIgnoreCase(MenuItemThen
                        mi.Image = fx.LoadImage(Dir,ImageName)
                        
    Return
                    
    End If
                
    Next
            
    End If
        
    Next
    End Sub

    'Description: Disable / Enable MenuItem
    'Tag: MenuItem, disable, enable
    'Usage: MenuItemEnable(MenuBar1,"File","Copy",False)
    Sub MenuItemEnable(MBar As MenuBar, MainMenu As StringMenuItem As String, bEnabled As Boolean)
        
    Dim lMenus As List = MBar.menus
        
    For Each strMenu As Menu In lMenus
            
    Dim mText As String = strMenu.text
            
    If mText.EqualsIgnoreCase(MainMenu) Then
                
    For Each mi As MenuItem In strMenu.MenuItems
                    
    Dim miText As String = mi.Text
                    
    If miText.EqualsIgnoreCase(MenuItemThen
                        mi.enabled = bEnabled
                        
    Return
                    
    End If
                
    Next
               
            
    End If
        
    Next
    End Sub
     
  18. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: Consolidate two lists and ensure there are no duplicates
    'Tag: Lists, join, map
    'Usage: Dim consol as List = ConsolidateLists(list1,list2)
    Sub ConsolidateLists(lst1 As List, lst2 As ListAs List
        
    Dim nMap As Map
        nMap.Initialize
        
    For Each strKey As String In lst1
            nMap.Put(strKey,strKey)
        
    Next
        
    For Each strKey As String In lst2
            nMap.Put(strKey,strKey)
        
    Next
        
    Dim nList As List
        nList.Initialize
        
    For Each strKey As String In nMap.Keys
            nList.Add(strKey)
        
    Next
        nList.Sort(
    True)
        
    Return nList
    End Sub
     
  19. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: Find the maximum number in the list (items should be numeric)
    'Tag: List, Max, CInt
    'Usage: Dim maxof As Int = MaxOfList(list1)
    Sub MaxOfList(lst As ListAs Int
        
    Dim maxcnt As Int = 0
        
    Dim curCnt As Int = 0
        
    For Each strID As String In lst
            curCnt = CInt(strID)
            
    If curCnt > maxcnt Then maxcnt = curCnt
        
    Next
        
    Return maxcnt
    End Sub

    'Description: Find the minimum number in the list (items should be numeric)
    'Tag: List, Min, CInt
    'Usage: Dim minof As Int = MinOfList(list1)
    Sub MinOfList(lst As ListAs Int
        
    'lets get the first value
        Dim fValue As String = lst.Get(0)
        
    Dim maxcnt As Int = CInt(fValue)
        
    Dim curCnt As Int = 0
        
    For Each strID As String In lst
            curCnt = CInt(strID)
            
    If curCnt < maxcnt Then maxcnt = curCnt
        
    Next
        
    Return maxcnt
    End Sub
     
  20. Mashiane

    Mashiane Well-Known Member Licensed User

    Code:
    'Description: Copy a file from one directory to another, use same file name with option to replace. If you dont replace the file it wont be recopied if it exists
    'Tag: File.Copy, replace file
    'Usage: File_Copy(File.DirAssets,"mashy.png",File.DirApp,True)
    Sub File_Copy(SourceDir As String, SourceFile As String, TargetDir As String, bReplace As Boolean)
        
    If bReplace = True Then
            
    File.Copy(SourceDir,SourceFile,TargetDir,SourceFile)
        
    Else
            
    If File.Exists(TargetDir,SourceFile) = False Then
                
    File.Copy(SourceDir,SourceFile,TargetDir,SourceFile)
            
    End If
        
    End If
    End Sub
     
Loading...