Android Code Snippet Sharing the goodness: Some useful methods

Hi

This is a collection of methods that I have collected here in b4a, perhaps one can find them useful..

'Description: Return Left part of a string
'Tags: left method, string
Sub Left(Text As String, Length As Long)As String
   If Length>Text.Length Then Length=Text.Length
   Return Text.SubString2(0, Length)
End Sub

'Description: Return Right part of a string
'Tags: right method, string
Sub Right(Text As String, Length As Long) As String
   If Length>Text.Length Then Length=Text.Length
   Return Text.SubString(Text.Length-Length)
End Sub

'Description: Return the Mid portion of a string
'Tags: mid method, string
Sub Mid(Text As String, Start As Int, Length As Int) As String
   Return Text.SubString2(Start-1,Start+Length-1)
End Sub

'Description: Returns an array from a delimited string
'Tags: split method, string
Sub Split(Text As String, Delimiter As String) As String()
   Return Regex.Split(Delimiter,Text)
End Sub

'Description: Returns the length of a string
'Tags: length of string, len
Sub Len(Text As String) As Int
    Return Text.Length
End Sub

'Description: Replace a string within a string
'Tags: Replace function, string
Sub Replace(Text As String, sFind As String, sReplaceWith As String) As String
    Return Text.Replace(sFind, sReplaceWith)
End Sub

' Description: Return a string in lowercase
'Tags: lower case string, lcase
Sub LCase(Text As String) As String
    Return Text.ToLowerCase
End Sub

'Description: Return a string in uppercase
'Tags: upper case, ucase
Sub UCase(Text As String) As String
    Return Text.ToUpperCase
End Sub

'Description: Trim a string
'Tags: trim, string
Sub Trim(Text As String) As String
    Return Text.Trim
End Sub

'Description: Return position of sub string within a string
'Tags: indexof, position
Sub InStr(Text As String, sFind As String) As Int
    Return Text.IndexOf(sFind)
End Sub

'Description: Return position of a sub string within a string starting from a position
'Tags: indexof, position, string
Sub InStr1(iStart As Int, Text As String, sFind As String) As Int
    Return Text.IndexOf2(Text, iStart)
End Sub

'Description: Return position of a substring within a string starting from the back
'Tags: instrrev, string
Sub InStrRev(Text As String, str As String) As Int
    Return Text.LastIndexOf(str)
End Sub

'Description: Returns true if a string contains another string
'Tag: string, contains
Sub Contains(Text As String, sFind As String) As Boolean
    Return Text.Contains(sFind)
End Sub

'Description: check if device has internet connection
'Tags: internet,connection
Sub HasInternet() As Boolean
    Dim  Server As ServerSocket
    Server.Initialize(0, Null)
    If Server.GetMyIP = "127.0.0.1" Then 'Test for internet connection
        Return False
    Else
        Return True
    End If
End Sub

'Description: sum all the values in a list
'Tags: list,sum
Sub ListSum(lst As List) As String
    Dim lTot As Int = lst.Size - 1
    Dim lCnt As Int
    Dim lStr As Int
    Dim lSum As Int = 0
 
    For lCnt = 0 To lTot
        lStr = lst.Get(lCnt)
        lSum = lSum + lStr
    Next
    Return lSum
End Sub

'Description: Returns True if the CurrentDate and the CompareToDate are within X number of days(DateRange)
'of each other. Otherwise False will be returned.
'Tags: Date, search, range
Sub SearchDate(CurrentDate As String, CompareToDate As String, DateRange As Int) As Boolean
    Dim DayOfYearCompareDate, DayOfYearCurrentDate As Long
    If ValidDate(CurrentDate) And ValidDate(CompareToDate) Then
    Else
        Return False
    End If
    DayOfYearCompareDate = DateTime.GetDayOfYear(DateTime.DateParse(CompareToDate))
    DayOfYearCurrentDate = DateTime.GetDayOfYear(DateTime.DateParse(CurrentDate))
    If DayOfYearCompareDate >= DayOfYearCurrentDate And DayOfYearCompareDate <= (DayOfYearCurrentDate + DateRange) Then
        Return True
    Else
        Return False
    End If
End Sub

'Description: Return the date tomorrow in ticks
'Tags: date, tomorrow
Sub Tomorrow() As Long
    Dim Tom As Long
    Tom = DateTime.Add(DateTime.Now, 0, 0, 1)
    Return DateTime.Date(Tom)
End Sub

'Description: Convert a json file to a map
'Tags: json, map, conversion
Sub JsonFileToMap(Dir As String, FileName As String) As Map
    Dim JSON As JSONParser
    Dim Map1 As Map
    JSON.Initialize(File.ReadString(Dir, FileName))
    Map1 = JSON.NextObject
    Return Map1
End Sub

'Description: Convert a json string to a map
'Tags: json, string, map, conversion
Sub Json2Map(jsonText As String) As Map
    Dim json As JSONParser
    Dim Map1 As Map
    json.Initialize(jsonText)
    Map1 = json.NextObject
    Return Map1
End Sub

'Description: Returns whether the passed date is valid or not
'Tags: date validation,date
Public Sub ValidDate(ChkDate As String) As Boolean
    Private dcf As Int
    Private GoodDate As String
    dcf = 0
    Try
        GoodDate = DateTime.DateParse(ChkDate)
    Catch
        GoodDate = ""
        dcf = 1
    End Try
    If dcf = 0 Then
        Return True
    Else
        Return False
    End If 
End Sub

'Description: Returns a new date when adding them to an existing date
'Tags: Date, addition, calculation
Sub DateAdd(mDate As String, HowManyDays As Int) As String
    Dim ConvertDate, NewDateDay As Long
    ConvertDate = DateTime.DateParse(mDate)
    NewDateDay = DateTime.Add(ConvertDate, 0, 0, HowManyDays)
    Return DateTime.Date(NewDateDay)
End Sub

'Description: Returns the number of days that have passed between two dates.
'Pass the dates as a String
'Tags: Date, differences, calculation
Sub DateDiff(CurrentDate As String, OtherDate As String) As Int
    Dim CurrDate, OthDate, MyNewDate As Long
    CurrDate = DateTime.DateParse(CurrentDate)
    OthDate = DateTime.DateParse(OtherDate)
    Return (CurrDate-OthDate)/(DateTime.TicksPerDay)
End Sub


'Description: Return the position of a string within another
'Tags: at, string position
Sub At(Text As String,SearchFor As String) As Int
    Return Text.IndexOf(SearchFor)
End Sub

'Description: Return the left trimmed string from another
'Tags: ltrim, trim, left
Sub Ltrim(Text As String) As String
    Do While Left(Text, 1) =" "
        Text = Right(Text, Len(Text)-1)
    Loop
    Return Text
End Sub

'Description: Return the right trimmed string from another
'Tags: rtrim, trim, string
Sub Rtrim(Text As String) As String
    Do While Right(Text, 1) =" "
        Text = Left(Text, Len(Text)-1)
    Loop
    Return Text
End Sub

'Description: VB val function equivalent to return all numeric values in a string
'Tags: val, string, numericonly
Sub Val(Text As String) As String
    Do While IsNumber(Right(Text,1))=False Then
        If Len(Text) >0 Then
            Text=Left(Text, Len(Text)-1)
        Else
            Exit
        End If 
    Loop
    If Len(Text) > 0 Then
        Return Text + 0
    Else
        Return 0
    End If 
End Sub

'Description: vb IIf equivalent function
'Tags:iif
Sub iif(Text As String, Text1 As String, Text2 As String) As String
    If Text = True Then Return Text1 Else Return Text2
End Sub

'Description: Pauses operation
'Tags: pause, execution
Sub Pause(Tvar As Int)
    Dim Tstart As Long
    Tstart = DateTime.Now
    Do While DateTime.Now-Tstart < (Tvar*1000)
    Loop
End Sub

'Description: Return space made of number of
'Tags: space
Sub Space(HM As Int) As String
    Dim RS As String = ""
    Do While Len(RS) < HM
        RS = RS & " "
    Loop
    Return RS
End Sub

'Description: Load a combobox from a multi value delimited string
'Tags: combobox, picker, delimited
Sub ComboBoxFromMV(cbo As Spinner, sValues As String, sDelim As String, bClear As Boolean, xPrefix As String)
    ' load a combo box from multi value fields
    If bClear = True Then cbo.Clear
    Dim spvalues() As String
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    spvalues = Regex.Split(sDelim, sValues)
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.Trim
        ivalue = xPrefix & ivalue
        cbo.Add(ivalue)
    Next
End Sub

'Description: Returns a list from a multi value delimited string
'Tags: List, multi-value string,delimited
Sub ListFromMV(lst As List, sValues As String, sDelim As String, bClear As Boolean, bClean As String, xPrefix As String)
    ' convert multi value fields to a list
    If bClear = True Then lst.Initialize
    Dim spvalues() As String
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    spvalues = Regex.Split(sDelim, sValues)
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.Trim
        ivalue = xPrefix & ivalue
        If bClean = True Then ivalue = CleanValue(ivalue)
        If lst.IndexOf(ivalue) = -1 Then lst.Add(ivalue)
    Next
End Sub

'Description: Return a cleaned string without the values specified only
'Tags: string, replace
Public Sub CleanValue(sValue As String) As String
    sValue = sValue.replace(" ","")
    sValue = sValue.Replace(".","")
    sValue = sValue.Replace("-","")
    sValue = sValue.Replace("&","")
    sValue = sValue.Trim
    Return sValue
End Sub

'Description: Copy values from one combobox to another
'Tags: combobox, picker, copy
Sub ComboBoxCopy(cboSource As Spinner, cboTarget As Spinner)
    cboTarget.Clear
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    itot = cboSource.Size - 1
    For i = 0 To itot
        ivalue = cboSource.GetItem(i)
        cboTarget.Add(ivalue)
    Next
End Sub

'Description: Return true if device being used is a tablet
'Tags: device size
Sub IsTablet() As Boolean
    Dim lv As LayoutValues
    lv = GetDeviceLayoutValues
       Dim DeviceSize As Int = lv.ApproximateScreenSize
    If DeviceSize >= 6 Then
        Return True
    Else
        Return False
    End If
End Sub

'Description: search for a string in a multi value string and return position
'Tags: search, multi-value string
Sub MvSearch(searchvalues As String,strsearch As String,delim As String) As Int
    If searchvalues.length = 0 Then Return -1
    Dim spvalues() As String
    Dim i As Int, itot As Int, ivalue As String
    spvalues = Regex.Split(delim,searchvalues)
    strsearch = strsearch.ToLowerCase
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.ToLowerCase
        If ivalue = strsearch Then Return i
    Next
    Return -1
End Sub

 

[Mashiane]

'Description: remove any duplicates in a multi value string
'Tags: multi-value string, remove duplicates
Sub MvRemoveDuplicates(strmv As String,delim As String) As String
    Dim sout As String: sout = ""
    Dim spv() As String: spv = Regex.Split(delim,strmv)
    Dim stot As Int, scnt As Int, sitem As String
    Dim xpos As Int
    stot = spv.length - 1
    For scnt = 0 To stot
        sitem = spv(scnt)
        sitem = sitem.Trim
        If sitem.length > 0 Then
            xpos = MvSearch(sout,sitem,delim)
            If xpos = -1 Then
                If sout.length = 0 Then
                    sout = sitem
                Else
                    sout = sout & delim & sitem
                End If
            End If
        End If
    Next
    Return sout
End Sub

 

[Mashiane]

'Description: remove an item from a multivalue string
'Tags: remove string, split
Sub MvRemoveItem(strmv As String,sremove As String,delim As String) As String
    sremove = sremove.ToLowerCase
    Dim sout As String = ""
    Dim spv() As String
    Dim sitem As String
    spv = Regex.Split(delim, strmv)
    For scnt = 0 To spv.Length -1
        sitem = spv(scnt).ToLowerCase
        If sitem <> sremove Then
            If sout.Length = 0 Then
                sout = spv(scnt)
            Else
                sout = sout & delim & spv(scnt)
            End If
        End If
    Next
    Return sout
End Sub

 

[Mashiane]

'Description: long method to replace escape sequences
'Tags: escape sequences, url
Sub EscapeURL(s As String) As String
    Dim encoded As String
    encoded = s
    encoded = encoded.Replace("%", "%25") 'NB this must be done first so as not to replace the %
    encoded = encoded.Replace(" ", "%20")
    encoded = encoded.Replace("<", "%3C")
    encoded = encoded.Replace(">", "%3E")
    encoded = encoded.Replace("#", "%23")      
    encoded = encoded.Replace("{", "%7B")
    encoded = encoded.Replace("}", "%7D")
    encoded = encoded.Replace("|", "%7C")
    encoded = encoded.Replace("\", "%5C")
    encoded = encoded.Replace("^", "%5E")
    encoded = encoded.Replace("~", "%7E")
    encoded = encoded.Replace("[", "%5B")
    encoded = encoded.Replace("]", "%5D")
    encoded = encoded.Replace("`", "%60")
    encoded = encoded.Replace(";", "%3B")
    encoded = encoded.Replace("/", "%2F")
    encoded = encoded.Replace("?", "%3F")
    encoded = encoded.Replace(":", "%3A")
    encoded = encoded.Replace("@", "%40")
    encoded = encoded.Replace("=", "%3D")
    encoded = encoded.Replace("&", "%26")
    encoded = encoded.Replace("$", "%24")
    encoded = encoded.Replace("+", "%2B")
    encoded = encoded.Replace("-", "%2D")
    encoded = encoded.Replace(CRLF, "%0D%0A")
    Return encoded
End Sub

 

[Mashiane]

'Description: return xml from json string
'Tags: json, xml, conversion
Sub Json2Xml(jsontext As String, includeNamespace As Boolean) As String
    Dim x As XMLBuilder
    Dim jo As JavaObject
    jo.InitializeNewInstance("org.json.JSONObject",Array As Object(jsontext))
    Dim jo2 As JavaObject
    jo2.InitializeNewInstance("org.json.XML", Null)
    Dim xml As String = jo2.RunMethod("toString", Array(jo))
    'if you need to include an xmlnamespace set includenamespace to true
    If includeNamespace Then
        x = x.Create("top") _
        .text(xml) _
        .up()
        Dim xmlProps As Map
        xmlProps.Initialize
        xmlProps.Put("indent", "yes")
        Return x.asString2(xmlProps).Replace("&lt;","<").Replace("&gt;",">")
        Else
            Return xml
        End If
End Sub

 

[Mashiane]

'Description: convert xml to json string
'Tags: xml, json, conversion
Sub Xml2Json(xml As String) As String
'nothing to do in this sub it just works
    Dim jo As JavaObject
    Dim JSON As JSONParser
    Dim jg1 As JSONGenerator

    jo.InitializeNewInstance("org.json.XML", Null)
    Dim jml As String = jo.RunMethod("toJSONObject", Array(xml))

    Dim Map1 As Map
    JSON.Initialize(jml)
    Map1 = JSON.NextObject

    jg1.Initialize(Map1)
    Return jg1.ToString
End Sub

'Description: convert xml to map
'Tags: xml, map, conversion
Sub Xml2Map(xml As String) As Map
    'nothing to do in this sub it just works
    Dim jo As JavaObject
    Dim JSON As JSONParser
 
    jo.InitializeNewInstance("org.json.XML", Null)
    Dim jml As String = jo.RunMethod("toJSONObject", Array(xml))

    Dim Map1 As Map
    Map1.Initialize
    JSON.Initialize(jml)
    Map1 = JSON.NextObject
 
    Dim M As Map
    M = Map1.GetValueAt(0)
    Return M
End Sub

 

[Mashiane]

'Description: return numeric values from a string. This picks ups dot and negative sign
'Tags: val method, numbers only
Public Sub NumericOnly(value As String) As String
    value = value.Trim
    Dim sout As String = ""
    Dim mout As String = ""
    Dim slen As Int = value.Length
    Dim i As Int = 0
    For i = 0 To slen - 1
        mout = value.CharAt(i)
        If InStr("0123456789.-", mout) <> -1 Then
            sout = sout & mout
        End If
    Next
    Return sout
End Sub

 

[Mashiane]

'Description: Removes any duplicates items in a list
'Tags: list, remove duplicates
Sub ListRemoveDuplicates(xL As List) As List
    Dim nList As List
    nList.Initialize
    Dim i As Int
    Dim itm As String
    For i = 0 To xL.Size - 1
        itm = xL.Get(i)
        itm = itm.Trim
        If itm.Length > 0 Then
            If nList.IndexOf(itm) = -1 Then nList.Add(itm)
        End If
    Next
    Return nList
End Sub

 

[Mashiane]

'Description: Convert a list to an array
'Tags: List, array, conversion
Public Sub ListToArray(lstFrom As List) As String()
    Dim totLst As Int: totLst = lstFrom.Size
    Dim rslt(totLst) As String
    Dim i As Int
    For i = 0 To totLst -1
        rslt(i) = lstFrom.Get(i)
    Next
    Return rslt
End Sub

 

[Mashiane]

'Description: Returns the number of delimited strings
'Tags: multi-value field, delimiter, count, split
Sub MvCount(strMV As String, Delim As String) As Int
    If strMV.Length = 0 Then Return 0
    Dim xPos As Int: xPos = strMV.IndexOf(Delim)
    If xPos = -1 Then Return 1
    Dim spValues() As String
    spValues = Regex.Split(Delim, strMV)
    Return spValues.Length
End Sub

 

[Mashiane]

'Description: get a multi value field within a delimited string
'Tags: delimited string, split
Sub MvField(sValue As String, iPosition As Int, Delimiter As String) As String
    If sValue.Length = 0 Then Return ""
    Dim xPos As Int: xPos = sValue.IndexOf(Delimiter)
    If xPos = -1 Then Return sValue
    Dim mValues() As String
    Dim tValues As Int
    mValues = Regex.split(Delimiter, sValue)
    tValues = mValues.Length -1
    Select Case iPosition
    Case -1
        Return mValues(tValues)
    Case -2
        Return mValues(tValues - 1)
    Case Else
        iPosition = iPosition - 1
        If iPosition <= -1 Then Return mValues(tValues)
        If iPosition > tValues Then Return ""
        Return mValues(iPosition)
    End Select
End Sub

 

[Mashiane]

'Description: Return the current system year
'Tags: year, date, today
Public Sub YearNow() As String
    Dim lNow As Long
    Dim dt As String
    lNow = DateTime.Now
    DateTime.DateFormat = "yyyy"
    dt = DateTime.Date(lNow)
    Return dt
End Sub

'Description: Return the current system date in long format
'Tags: date, long format
Public Sub DateTimeNow() As String
    Dim lNow As Long
    Dim dt As String
    lNow = DateTime.Now
    DateTime.DateFormat = "yyyy-MM-dd HH:mm"
    dt = DateTime.Date(lNow)
    Return dt
End Sub

 

[Mashiane]

'Description: Return today as yyyy-MM-dd format
'Tags: date, today, format
Public Sub YYYYMMDDNow() As String
    Dim lNow As Long
    Dim dt As String
    lNow = DateTime.Now
    DateTime.DateFormat = "yyyy-MM-dd"
    dt = DateTime.Date(lNow)
    Return dt
End Sub

 

[Mashiane]

'Description: Return the date of the week today
'Tags: date, today
Public Sub TodayWeekDay() As String
    Dim lNow As Long
    lNow = DateTime.Now
    Return DateUtils.GetDayOfWeekName(lNow)
End Sub

'Description: Return the date yesterday
'Tags: yesterday, date,
Public Sub YesterdayWeekDay() As String
    Dim p As Period
    p.Days = -1
    Dim SomeDate As Long = DateTime.Now
    Dim NewDate As Long = DateUtils.AddPeriod(SomeDate, p)
    Return DateUtils.GetDayOfWeekName(NewDate)
End Sub

 

[Mashiane]

'Description: removes the last delimiter from a string
'Tags: string, delimiter
Sub RemDelim(sValue As String, Delim As String) As String
    Dim lDelim As Int = Delim.Length
    Dim nValue As String = sValue
    If nValue.EndsWith(Delim) Then nValue = nValue.SubString2(0, nValue.Length-lDelim)
    Return nValue
End Sub

 

[Mashiane]

'Description: use the WinSMS service to send an sms
'Tags: send sms using service
Sub SendWinSMS(country As String,mobile As String,message As String, form As Object)
    ProgressDialogShow("Working on it...")
    DoEvents
    Dim WinSMS As String
    Dim winSmsUser As String: winSmsUser="xx@xxxx"
    Dim winSmsPwd As String: winSmsPwd="xxx"
    ' remove zero from mobile phone and put country code infront
    ' we will assume 27 for south africa
    mobile = FixMobile(mobile)
    mobile = mobile.SubString(1)
    mobile = country & mobile
    ' define the sms sender for winsms
    message = EscapeURL(message)
    WinSMS = "user=" & winSmsUser & "&password=" & winSmsPwd & "&message=" & message & "&Numbers=" & mobile & ";"
       Dim url As String = "http://www.winsms.co.za/api/batchmessage.asp"
    Dim Job1 As HttpJob  
    Job1.Initialize("SendWinSMS", form)
    Job1.Tag = mobile
    Job1.PostString(url, WinSMS)
End Sub   

Sub SendWinSMSOk(sValue As String) As Boolean

If sValue.length = 0 Then Return False

Dim nc As Boolean, fl As Boolean, id As Boolean

nc = sValue.Contains("NOCREDITS")

fl = sValue.Contains("FAIL")

id = sValue.Contains("INVALID")

If nc = False And fl = False And id = False Then

Return True

Else

Return False

End If

End Sub

 

[Mashiane]

'Description: convert a json string to a list
'Tags: json, list, conversion
Sub Json2List(jsonTxt As String) As List
    ' check if the first two characters are indeed json
    Dim res As List
    res.Initialize
    Dim left2 As String = Left(jsonTxt, 2)
    Select Case left2
    Case "[{"
        ' this is the correct expected string
        Dim parser As JSONParser
        parser.Initialize(jsonTxt)
        res = parser.NextArray
    End Select
    Return res
End Sub

 

[Danbicky]

Mate, Awesome, you are the code hound lol

Brilliant work this will come in very handy for many of us here.

Thanks

Dans

 

[moster67]

That is a nice collection. Thanks for sharing

 

[aidymp]

These are very useful,

Thank you

Aidy