Android Question Listing all Subs in project

RB Smissaert

Well-Known Member
Licensed User
Longtime User
Is it possible to list all Subs in a project showing the Sub's name and the name of the module that Sub is in?
The closest I can get is doing a quick search for Sub, but unfortunately it looks you can't copy the content of
the window that list shows in.
After some simple processing (eg in Excel) I would like a list like this:

module_type module_name Sub_Name
-----------------------------------------------------
B4XPage B4XMainPage ShowAbout
Class clsConnection Connect2DB
Code_Module Enums Process_Globals

etc.

The purpose of it all is to see if all Subs from an activity based project have been transferred to a B4XPages project and if not
what is still missing.

RBS
 

RB Smissaert

Well-Known Member
Licensed User
Longtime User
I solved this now by writing a simple parser parsing all the (used) .bas files and the file B4AProject.b4a in the project folder after copying all the relevant files to a folder
in File.DirRootExternal. All working nicely:

B4X:
Sub ListAllSubs
    
    Dim i As Int
    Dim oMap As Map
    Dim lstSubs As List
    
    'this shows that B4XPages .bas files and code module .bas files and most class .bas files are not in File.DirAssets
    '------------------------------------------------------------------------------------------------------------------
'    Dim lstFiles As List = File.ListFiles(File.DirAssets)
'    
'    For i = 0 To lstFiles.Size - 1
'        Log(i & " - " & lstFiles.Get(i))
'    Next
    
    oMap = ParseCodeFiles(File.DirRootExternal & "/PhonePats/CodeFiles")
    
    For Each strKey As String In oMap.Keys
        Log("--------------------------------------------")
        Log("Module: " & strKey)
        lstSubs = oMap.Get(strKey)
        For i = 0 To lstSubs.Size - 1
            Log(lstSubs.Get(i))
        Next
    Next
    
End Sub

Sub ParseCodeFiles(strFolder As String) As Map
    
    Dim i As Int
    Dim strB4AProject As String
    Dim strModuleName As String
    Dim lstModules As List
    Dim strSubName As String
    Dim iSubNameEnd As Int
    Dim strCode As String
    Dim strCodeLC As String
    Dim arrLines() As String
    Dim iEqualsPos As Int
    Dim iSubPos As Int
    Dim iAsPos As Int
    Dim iOpenBracketPos As Int
    Dim iNextLinebreakPos As Int
    Dim mapModules As Map
    
    lstModules.Initialize
    mapModules.Initialize
    
    strB4AProject = File.GetText(strFolder, "B4AProject.b4a")
    
    arrLines = Regex.Split(CRLF, strB4AProject)
    
    For i = 0 To arrLines.Length - 1
        If arrLines(i).ToLowerCase.StartsWith("module") Then
            iEqualsPos = arrLines(i).IndexOf("=")
            strModuleName = arrLines(i).SubString(iEqualsPos + 1).Trim
            If strModuleName.Contains("=") = False Then
                lstModules.Add(strModuleName)
            End If
        End If
    Next
    
    For i = 0 To lstModules.Size - 1
        
        strModuleName = lstModules.Get(i)

        strCode = File.GetText(strFolder, strModuleName & ".bas")
        strCodeLC = strCode.ToLowerCase
        
        Dim lstSubs As List
        lstSubs.Initialize
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 4)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 4)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "sub ", iSubPos + 1)
        Loop
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "private sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 13)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 13)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "private sub ", iSubPos + 1)
        Loop
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "public sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 12)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 12)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "public sub ", iSubPos + 1)
        Loop
        
        If strCodeLC.Contains("type=staticcode") Then
            mapModules.Put(strModuleName & " (code module) " & lstSubs.Size, lstSubs)
        Else
            If strCodeLC.Contains("type=service") Then
                mapModules.Put(strModuleName & " (service module) " & lstSubs.Size, lstSubs)
            Else
                If strCodeLC.Contains("type=class") Then
                    If strCodeLC.Contains("private sub b4xpage_created") Then
                        mapModules.Put(strModuleName & " (B4XPages class) " & lstSubs.Size, lstSubs)
                    Else
                        mapModules.Put(strModuleName & " (normal class) " & lstSubs.Size, lstSubs)
                    End If
                Else
                    mapModules.Put(strModuleName & " " & lstSubs.Size, lstSubs)
                End If
            End If
        End If
        
    Next 'For i = 0 To lstModules.Size - 1
    
    Return mapModules
    
End Sub

RBS
 
Upvote 0

RB Smissaert

Well-Known Member
Licensed User
Longtime User
Just noticed one shortcoming of the posted code and that is it won't work with an activity based project as there is no file Main.bas and Main is not listed in the
project .B4A file. Only solution I can see for now is copy the code text of Main of the activity based project and save that as a .bas file to the mentioned folder and
add the word Main to the .B4A project file.

RBS
 
Upvote 0

RB Smissaert

Well-Known Member
Licensed User
Longtime User
Forget about this as just noticed that the in an activity based project the code text of Main is in the .B4A project file.

RBS
 
Upvote 0

RB Smissaert

Well-Known Member
Licensed User
Longtime User
To make it work with both an activity based project and a B4XPages project the main code should be different as posted and this works fine:

B4X:
Sub ParseCodeFiles(strFolder As String, strB4AFile As String) As Map
    
    Dim i As Int
    Dim strB4AProjectText As String
    Dim strModuleName As String
    Dim bModule As Boolean
    Dim lstModules As List
    Dim strSubName As String
    Dim iSubNameEnd As Int
    Dim strCode As String
    Dim strCodeLC As String
    Dim arrLines() As String
    Dim iEqualsPos As Int
    Dim iSubPos As Int
    Dim iAsPos As Int
    Dim iOpenBracketPos As Int
    Dim iNextLinebreakPos As Int
    Dim mapModules As Map
    
    lstModules.Initialize
    mapModules.Initialize
    
    strB4AProjectText = File.GetText(strFolder, strB4AFile)
    
    arrLines = Regex.Split(CRLF, strB4AProjectText)
    
    For i = 0 To arrLines.Length - 1
        If arrLines(i).ToLowerCase.StartsWith("module") Then
            iEqualsPos = arrLines(i).IndexOf("=")
            strModuleName = arrLines(i).SubString(iEqualsPos + 1).Trim
            If strModuleName.Contains("=") = False Then
                lstModules.Add(strModuleName)
                bModule = True
            End If
        Else
            If bModule Then
                Exit
            End If
        End If
    Next
    
    'as this file holds Subs as well, a lot more if we have an activity based project with lots of code in Main!
    '-----------------------------------------------------------------------------------------------------------
    lstModules.Add(strB4AFile.SubString2(0, strB4AFile.Length - 4))
    
    For i = 0 To lstModules.Size - 1
        
        strModuleName = lstModules.Get(i)
        
        If i = lstModules.Size - 1 Then
            strCode = File.GetText(strFolder, strB4AFile)
        Else
            strCode = File.GetText(strFolder, strModuleName & ".bas")
        End If
        
        strCodeLC = strCode.ToLowerCase
        
        Dim lstSubs As List
        lstSubs.Initialize
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 4)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 4)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "sub ", iSubPos + 1)
        Loop
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "private sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 13)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 13)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "private sub ", iSubPos + 1)
        Loop
        
        iSubPos = 0
        iSubPos = strCodeLC.IndexOf2(CRLF & "public sub ", iSubPos)
        Do While iSubPos > -1
            iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + 12)
            iNextLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + 12)
            If iOpenBracketPos > -1 Then
                iSubNameEnd = Min(iOpenBracketPos, iNextLinebreakPos)
            Else
                iSubNameEnd = iNextLinebreakPos
            End If
            strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
            iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
            If iAsPos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            Else
                lstSubs.Add(strSubName)
            End If
            iSubPos = strCodeLC.IndexOf2(CRLF & "public sub ", iSubPos + 1)
        Loop
        
        If i = lstModules.Size - 1 Then
            mapModules.Put("Main" & " (activity module) " & lstSubs.Size, lstSubs)
        Else
            If strCodeLC.Contains("type=class") Then
                If strCodeLC.Contains("private sub b4xpage_created") Then
                    mapModules.Put(strModuleName & " (B4XPages class) " & lstSubs.Size, lstSubs)
                Else
                    mapModules.Put(strModuleName & " (normal class) " & lstSubs.Size, lstSubs)
                End If
            Else
                If strCodeLC.Contains("type=service") Then
                    mapModules.Put(strModuleName & " (service module) " & lstSubs.Size, lstSubs)
                Else
                    If strCodeLC.Contains("type=staticcode") Then
                        mapModules.Put(strModuleName & " (code module) " & lstSubs.Size, lstSubs)
                    Else
                        mapModules.Put(strModuleName & " " & lstSubs.Size, lstSubs)
                    End If
                End If
            End If
        End If
        
    Next 'For i = 0 To lstModules.Size - 1
    
    Return mapModules
    
End Sub


RBS
 
Upvote 0

RB Smissaert

Well-Known Member
Licensed User
Longtime User
Fixed 2 minor bugs of the posted code and this works all fine:

B4X:
Sub ParseCodeFiles(strFolder As String, strB4AFile As String) As Map
    
    Dim i As Int
    Dim strB4AProjectText As String
    Dim strModuleName As String
    Dim bModule As Boolean
    Dim lstModules As List
    Dim strCode As String
    Dim strCodeLC As String
    Dim arrLines() As String
    Dim iEqualsPos As Int
    Dim mapModules As Map
    
    lstModules.Initialize
    mapModules.Initialize
    
    strB4AProjectText = File.GetText(strFolder, strB4AFile)
    
    arrLines = Regex.Split(CRLF, strB4AProjectText)
    
    For i = 0 To arrLines.Length - 1
        If arrLines(i).ToLowerCase.StartsWith("module") Then
            iEqualsPos = arrLines(i).IndexOf("=")
            strModuleName = arrLines(i).SubString(iEqualsPos + 1).Trim
            If strModuleName.Contains("=") = False Then
                lstModules.Add(strModuleName)
                bModule = True
            End If
        Else
            If bModule Then
                Exit
            End If
        End If
    Next
    
    'as this file holds Subs as well, a lot more if we have an activity based project with lots of code in Main!
    '-----------------------------------------------------------------------------------------------------------
    lstModules.Add(strB4AFile.SubString2(0, strB4AFile.Length - 4))
    
    For i = 0 To lstModules.Size - 1
        
        strModuleName = lstModules.Get(i)
        
        If i = lstModules.Size - 1 Then
            strCode = File.GetText(strFolder, strB4AFile)
        Else
            strCode = File.GetText(strFolder, strModuleName & ".bas")
        End If
        
        strCodeLC = strCode.ToLowerCase
        
        Dim lstSubs As List
        lstSubs.Initialize
        
        GetSubNames(strCode, strCodeLC, CRLF & "sub ", lstSubs)
        GetSubNames(strCode, strCodeLC, CRLF & "private sub ", lstSubs)
        GetSubNames(strCode, strCodeLC, CRLF & "public sub ", lstSubs)
        
        If lstSubs.Size > 0 Then
            If i = lstModules.Size - 1 Then
                mapModules.Put("Main" & " (activity module) " & lstSubs.Size, lstSubs)
            Else
                If strCodeLC.Contains("type=class") Then
                    If strCodeLC.Contains("private sub b4xpage_created") Then
                        mapModules.Put(strModuleName & " (B4XPages class) " & lstSubs.Size, lstSubs)
                    Else
                        mapModules.Put(strModuleName & " (normal class) " & lstSubs.Size, lstSubs)
                    End If
                Else
                    If strCodeLC.Contains("type=service") Then
                        mapModules.Put(strModuleName & " (service module) " & lstSubs.Size, lstSubs)
                    Else
                        If strCodeLC.Contains("type=staticcode") Then
                            mapModules.Put(strModuleName & " (code module) " & lstSubs.Size, lstSubs)
                        Else
                            mapModules.Put(strModuleName & " " & lstSubs.Size, lstSubs)
                        End If
                    End If
                End If
            End If
        End If
        
    Next 'For i = 0 To lstModules.Size - 1
    
    Return mapModules
    
End Sub

Sub GetSubNames(strCode As String, strCodeLC As String, strLookFor As String, lstSubs As List)
    
    Dim iSubPos As Int
    Dim iAsPos As Int
    Dim iLookForLength As Int = strLookFor.Length
    Dim iOpenBracketPos As Int
    Dim iLinebreakPos As Int
    Dim iSingleQuotePos As Int
    Dim iSubNameEnd As Int
    Dim strSubName As String
    
    iSubPos = strCodeLC.IndexOf2(strLookFor, iSubPos) + 1
    
    Do While iSubPos > 0
        iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + iLookForLength)
        iLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + iLookForLength) - 1
        
        If iOpenBracketPos > -1 Then
            iSubNameEnd = Min(iOpenBracketPos, iLinebreakPos)
        Else
            iSubNameEnd = iLinebreakPos
        End If
        
        strSubName = strCode.SubString2(iSubPos, iSubNameEnd)
        
        iAsPos = strSubName.ToLowerCase.IndexOf(" as ")
        iSingleQuotePos = strSubName.IndexOf(Chr(39))
        
        If iAsPos > -1 Then
            If iSingleQuotePos > -1 Then
                iSubNameEnd = Min(iAsPos, iSingleQuotePos)
                lstSubs.Add(strSubName.SubString2(0, iSubNameEnd - 1))
            Else    
                lstSubs.Add(strSubName.SubString2(0, iAsPos))
            End If
        Else
            If iSingleQuotePos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iSingleQuotePos - 1))
            Else
                lstSubs.Add(strSubName)
            End If
        End If
        iSubPos = strCodeLC.IndexOf2(strLookFor, iSubPos + strLookFor.Length) + 1
    Loop
    
End Sub

I have one question regarding this and that is to do with these 2 code lines in the second Sub:

B4X:
        iOpenBracketPos = strCodeLC.IndexOf2("(", iSubPos + iLookForLength)
        iLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + iLookForLength) - 1

Why do I need to treat the CRLF different than the ( character?
CRLF has the same length (CRLF.Length) as the ( character.

RBS
 
Upvote 0

RB Smissaert

Well-Known Member
Licensed User
Longtime User
> Why do I need to treat the CRLF different than the ( character?
> CRLF has the same length (CRLF.Length) as the ( character.

This was because the B4A IDE allows extra spaces between for example a Sub name and a open bracket character.
I am more used to VBA/VB6 where the IDE takes these extra spaces away automatically.

For this reason the code of the Sub that gets the Sub names needs to be different, with trimming strings:

B4X:
Sub GetSubNames(strCode As String, strCodeLC As String, strLookFor As String, lstSubs As List)
    
    Dim iSubPos As Int
    Dim iAsPos As Int
    Dim iLookForLength As Int = strLookFor.Length
    Dim iOpenBracketPos As Int
    Dim iLinebreakPos As Int
    Dim iSingleQuotePos As Int
    Dim iSubNameEnd As Int
    Dim strSubName As String
    
    iSubPos = strCodeLC.IndexOf2(strLookFor, iSubPos) + 1
    
    Do While iSubPos > 0
        iOpenBracketPos = strCodeLC.IndexOf2(Chr(40), iSubPos + iLookForLength) 'there can be spaces between the sub name and the bracket, so we need a .Trim
        iLinebreakPos = strCodeLC.IndexOf2(CRLF, iSubPos + iLookForLength) 'there can be spaces between the sub name and the CRLF, so we need a .Trim
        
        If iOpenBracketPos > -1 Then
            iSubNameEnd = Min(iOpenBracketPos, iLinebreakPos)
        Else
            iSubNameEnd = iLinebreakPos
        End If
        
        strSubName = strCode.SubString2(iSubPos, iSubNameEnd).Trim
        
        iAsPos = strSubName.ToLowerCase.IndexOf(" as ") 'there can be spaces between the sub name and the " as ", so we need a .Trim
        iSingleQuotePos = strSubName.IndexOf(Chr(39)) 'there can be spaces between the sub name and the single quote, so we need a .Trim
        
        If iAsPos > -1 Then
            If iSingleQuotePos > -1 Then
                iSubNameEnd = Min(iAsPos, iSingleQuotePos)
                lstSubs.Add(strSubName.SubString2(0, iSubNameEnd).Trim)
            Else    
                lstSubs.Add(strSubName.SubString2(0, iAsPos).Trim)
            End If
        Else
            If iSingleQuotePos > -1 Then
                lstSubs.Add(strSubName.SubString2(0, iSingleQuotePos).Trim)
            Else
                lstSubs.Add(strSubName)
            End If
        End If
        iSubPos = strCodeLC.IndexOf2(strLookFor, iSubPos + strLookFor.Length) + 1
    Loop
    
End Sub

RBS
 
Upvote 0
Cookies are required to use this site. You must accept them to continue using the site. Learn more…