Blog

Autoindenting PHP Code

originaly written by Mark Rowlinson

Introduction

PHP code uses {} symbols to group pieces of code such as branches and loops. This code makes use of that by checking for the existence of them in each line. If it find a { then there should be a positive indent of the next line. If it finds a } then there should be a negative indent of the current line.

How to use the code

The code requires a reference to the “Microsoft Scripting Runtime” in order to make use of the FileSystemObject to read in and write out the file. Currently it is also written for Excel in that is uses GetOpenFileName to obtain the file to parse, this could easily be modified for VB to use a common dialog.

How it works

The code uses 1 Sub and 2 helper functions and uses a global variable to store the current indent level. When it starts it sets the indent to 0 and opens the file. It then loops through each line in the file, parses it using the FormatPHPLine function and stores it in an array. It then loops through the array to write the lines back out to the file The FormatPHPLine checks for the occurrence of { and } to detremine if a positive or negative indent is required. If a negative is found it is applied strightaway i.e. the global variable is decreased by 1. The required indent is then created using the indent function. Finally the global variable is increased by 1 if a positive indent was found.

Improvements

There is much scope for improvement, such as, allowing for multiple occurrences on one line or making sure only code not comments are searched which I may add in the future.

The Full Code

Dim intIndent As Long 
 
Sub FormatPHP() 
     
    Dim strFile As String 
    intIndent = 0 
    strFile = Application.GetOpenFilename("PHP Files (*.php),*.php") 
    If strFile = "False" Then Exit Sub 
    Dim fso As Scripting.FileSystemObject 
    Set fso = New Scripting.FileSystemObject 
    Dim ts As Scripting.TextStream 
    Dim strText() As String 
    Dim x As Integer 
    x = 0 
    Set ts = fso.OpenTextFile(strFile, ForReading, False) 
    While Not ts.AtEndOfStream 
        x = x + 1 
        ReDim Preserve strText(1 To x) 
        strText(x) = FormatPHPLine(ts.ReadLine) 
    Wend 
    ts.Close 
    Set ts = fso.OpenTextFile(strFile, ForWriting, False) 
    For i = 1 To x 
        ts.WriteLine strText(i) 
    Next i 
    ts.Close 
    MsgBox "Done!" 
End Sub 
 
Function FormatPHPLine(ByVal strPHP As String) As String 
     'check for { and } to determine indent
     'if { then positive indent
     'if } then negative
    Dim pos As Boolean, neg As Boolean 
    If InStr(1, strPHP, "{") > 0 Then 
        pos = True 
    End If 
    If InStr(1, strPHP, "}") > 0 Then 
        neg = True 
    End If 
     'apply negative indent
    If neg Then 
        intIndent = Application.WorksheetFunction.Max(0, intIndent - 1) 
    End If 
    strPHP = indent(strPHP) 
     'apply +ve indent
    If pos Then 
        intIndent = intIndent + 1 
    End If 
    FormatPHPLine = strPHP 
End Function 
 
Function indent(ByVal y As String) As String 
    y = Trim$(y) 
    If intIndent > 0 Then 
        For i = 1 To intIndent 
            indent = indent & vbTab 
        Next i 
        indent = indent & y 
    Else 
        indent = y 
    End If 
End Function 

An ongoing project we have on mind is to have a kind-of VBA port-language software, with the ultimately goal to get VBA code compiled, if this is anyway possible, to COM or DLL so code will be effectively hidden from prying eyes. There are some steps that have to be achieved in this process before getting the port:

1. Recognize special or reserved words
2. Set reserved words equivalences to other programming language
3. Detect procedures (Sub/Functions) and its variables
4. Detect objects (Type)
5. Detect enumeration variables (Enum)
6. Structure code in blocks (DoLoop, ForNext, IfThen…) that can be indepedent one from each other
7. Indent code (for better readability and comprenhension)
8. Port from VBA to new language
9. Revise code for unhandled exceptions

From here on, there is a high chance to get code compiled and reuse over Excel through VBA without exposing original code. So, other popular scripting languages, aside VBA, are Python, JavaScript and PHP, all of them had been already wrapped to run under Excel. Other languages considered, as they already have their own compiler, are C++, the collection on .Net platform, and Fortran, so their compiled DLLs can be used with Excel. If language port can be done to any one of those, then, it can be achived for them all.

---

VBA to JavaScript converter

My main interest now is focused in learning JS, and get the port from VBA to JavaScript. One site that game me some hints on how to start on the JS world came from here. The converter scripts are far from running, but the map to follow the conversions is compact and, somehow, clear. There are some functions in VBA but not in JS, so here comes very handy the collecting work done in this CodeProject article by Anele ‘Mashy’ Mbanga. Are these sites worth looking?, seems yes

• http://jsil.org/
• https://www.codeproject.com/Articles/25069/JSBasic-A-BASIC-to-JavaScript-Compiler
• http://jsc.sourceforge.net/

I started with the IF (elseif, else) block, then jumped to the FOR (for each) block, and ended with the LOOP (Do-While/Until, While-Wend) block. Let’s see the code:

Public Sub sV2J_If()
    Dim CodeBlock As String

    'CodeBlock = "If Condition1 = 1 Then If Condition2 = 2 Then If Condition3 = 3 Then Action: If Condition4 = 3 Then Action" & vbLf & _
                "If Condition1 = 1 Then" & vbLf & _
                vbTab & "If Sub1 = 1 Then" & vbLf & _
                vbTab & "   sub1 = 1.1" & vbLf & _
                vbTab & "ElseIf Sub2 = 2 Then" & vbLf & _
                vbTab & "   sub2 = 1.2" & vbLf & _
                vbTab & "ElseIf Sub3 = 3 Then" & vbLf & _
                vbTab & "   sub3 = 1.2" & vbLf & _
                vbTab & "Else" & vbLf & _
                vbTab & "   sub4 = 1.4" & vbLf & _
                vbTab & "End If" & vbLf & _
                "ElseIf Condition2 = 2 Then" & vbLf & _
                "   Statement2 = 2" & vbLf & _
                "ElseIf Condition3 = 3 Then" & vbLf & _
                "   Statement3 = 2" & vbLf & _
                "Else" & vbLf & _
                "   Statement4 = 2" & vbLf & _
                "End If"

    Call fVbCleaner(CodeBlock)

    'CodeBlock = fIf(CodeBlock:=CodeBlock, _
                    Then»:=" Then", _
                    If»:="if ", _
                    ElseIf»:="elseif ", _
                    Else»:="else", _
                    EndIf»:="end if", _
                    Then«:=" {", _
                    If«:="if ", _
                    ElseIf«:="elseif ", _
                    Else«:="else", _
                    EndIf«:="}", _
                    Opener«:=" {", _
                    Closer«:="} ", _
                    Indenter:=" ", _
                    Comment:="'")

    CodeBlock = "For lgCounter1 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "   Statement = lgCounter1" & vbLf & _
                "   For lgCounter2 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "      Statement = lgCounter2" & vbLf & _
                "      For lgCounter3 = LBound(aStatement) To UBound(aStatement)" & vbLf & _
                "         Statement = lgCounter3" & vbLf & _
                "      Next lgCounter3" & _
                "   Next lgCounter2" & _
                "Next lgCounter1"

    CodeBlock = fFor(CodeBlock:=CodeBlock, _
                     For»:="For ", _
                     Next»:="Next", _
                     Break»:="Exit For", _
                     For«:="for ", _
                     Next«:="continue", _
                     Break«:="continue", _
                     Opener«:=" {", _
                     Closer«:="} ", _
                     Indenter:=vbTab, _
                     Comment:="'")
Stop
    Debug.Print CodeBlock
End Sub

Public Function fJSCleaner(ByRef CodeBlock As String) As Boolean
'!!! ToDo: only if not inside comment block
    Dim aComment() As String
    Dim aStatement() As String
    Dim lgStatement As Long

    ' Clean code
    CodeBlock = VBA.Replace$(CodeBlock, vbTab, "  ")        ' Avoid odd chars
    CodeBlock = VBA.Replace$(CodeBlock, vbLf, vbCrLf)       ' Avoid impropper breaks
'!!!!
    CodeBlock = VBA.Replace$(CodeBlock, "; ", vbCrLf)       ' Avoid combined lines
'!!!!

    ' Avoid traps
    CodeBlock = VBA.Replace$(CodeBlock, "if(", "if (")
    CodeBlock = VBA.Replace$(CodeBlock, "elseif(", "elseif (")
    CodeBlock = VBA.Replace$(CodeBlock, "for(", "for (")

'!!!!
    ' Break one line If
'!!!!

    CodeBlock = VBA.Join(aStatement(), vbCrLf)
End Function

Public Function fVbCleaner(ByRef CodeBlock As String) As Boolean
'!!! ToDo: only if not inside comment block
    Dim aComment() As String
    Dim aStatement() As String
    Dim lgStatement As Long

    ' Clean code
    CodeBlock = VBA.Replace$(CodeBlock, vbTab, "  ")        ' Avoid odd chars
    CodeBlock = VBA.Replace$(CodeBlock, vbLf, vbCrLf)       ' Avoid impropper breaks
    CodeBlock = VBA.Replace$(CodeBlock, ": ", vbCrLf)       ' Avoid combined lines
    CodeBlock = VBA.Replace$(CodeBlock, " _" & vbCrLf, " ") ' Avoid line continuation

    ' Break one line If
    aStatement() = VBA.Split(CodeBlock, vbCrLf)
    For lgStatement = LBound(aStatement) To UBound(aStatement)
        Do While VBA.InStr(1, VBA.LCase$(aStatement(lgStatement)), " then ", vbTextCompare) > 0
            aStatement(lgStatement) = VBA.Replace$(aStatement(lgStatement), " then ", " Then" & vbCrLf, 1, 1, vbTextCompare) & vbCrLf & "End If"
        Loop
    Next lgStatement

    CodeBlock = VBA.Join(aStatement(), vbCrLf)
End Function

Public Function fIIf(ByVal CodeBlock As String)
'ternary Operator (cond ? truepart : falsepart)

End Function

Public Function fForEach(ByVal CodeBlock As String, _
                     Optional ByVal For» As String = "For ", _
                     Optional ByVal Break» As String = "Break", _
                     Optional ByVal Continue» As String = "Exit For", _
                     Optional ByVal For« As String = "for ", _
                     Optional ByVal Break« As String = "break", _
                     Optional ByVal Continue« As String = "continue", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
'for (x in person) {
'}
End Function

Public Function fFor(ByVal CodeBlock As String, _
                     Optional ByVal For» As String = "For ", _
                     Optional ByVal Next» As String = "Next", _
                     Optional ByVal Break» As String = "Exit For", _
                     Optional ByVal For« As String = "for ", _
                     Optional ByVal Next« As String = "continue", _
                     Optional ByVal Break« As String = "continue", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
    Dim aForStatement() As String
    Dim aStatement() As String
    Dim lgStatement As Long
    Dim lgStatements As Long
    Dim bNewVar As Boolean
    Dim bGotoNext As Boolean
    Dim Counter As String

    aForStatement() = VBA.Split(CodeBlock, ";")
    lgStatements = UBound(aForStatement) - LBound(aForStatement) + 1

    If lgStatements >= LBound(aForStatement) + 0 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 0)) = vbNullString Then
            'Optional
            Counter = aForStatement(LBound(aForStatement) + 1)
        Else
            If VBA.InStr(1, aForStatement(LBound(aForStatement) + 0), "var ") > 0 Then
                bNewVar = True
                Counter = aForStatement(LBound(aForStatement) + 0)
            Else
            End If
        End If

    ElseIf lgStatements >= LBound(aForStatement) + 1 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 1)) = vbNullString Then
            'Optional
        End If

    ElseIf lgStatements >= LBound(aForStatement) + 2 Then
        If VBA.Trim$(aForStatement(LBound(aForStatement) + 2)) = vbNullString Then
            'Optional
        End If
    End If

' for (i = 0; i < cars.length; i++) {
'}
'for(var x=0, x<n; x++){...}

End Function

Public Function fFor_(ByVal CodeBlock As String, _
                      Optional ByVal For» As String = "For ", _
                      Optional ByVal Break» As String = "Break", _
                      Optional ByVal Continue» As String = "Exit For", _
                      Optional ByVal For« As String = "for ", _
                      Optional ByVal Break« As String = "break", _
                      Optional ByVal Continue« As String = "continue", _
                      Optional ByVal Opener« As String = " {", _
                      Optional ByVal Closer« As String = "} ", _
                      Optional ByVal Indenter As String = vbTab, _
                      Optional ByVal Comment As String = "'") As String
End Function

Public Function fIf(ByVal CodeBlock As String, _
                    Optional ByVal Then» As String = " Then", _
                    Optional ByVal If» As String = "If ", _
                    Optional ByVal ElseIf» As String = "ElseIf ", _
                    Optional ByVal Else» As String = "Else", _
                    Optional ByVal EndIf» As String = "End If", _
                    Optional ByVal Then« As String = " {", _
                    Optional ByVal If« As String = "if ", _
                    Optional ByVal ElseIf« As String = "elseif ", _
                    Optional ByVal Else« As String = "else", _
                    Optional ByVal EndIf« As String = "}", _
                    Optional ByVal Opener« As String = " {", _
                    Optional ByVal Closer« As String = "} ", _
                    Optional ByVal Indenter As String = vbTab, _
                    Optional ByVal Comment As String = "'") As String
' Translate IF block

    Dim aStatement() As String
    Dim aStatementLevel() As Long
    Dim aStack() As Long
    Dim lgStatement As Long
    Dim lgStatement_End As Long
    Dim lgLevel As Long:    lgLevel = 0
    Dim strCode As String:  strCode = vbNullString
    Dim CodeOut As String:  CodeOut = vbNullString

    ' Split If sub-blocks
    CodeBlock = VBA.Replace$(CodeBlock, Then» & vbCrLf, vbCrLf)
    CodeBlock = VBA.Replace$(CodeBlock, Then», vbCrLf)
    aStatement() = VBA.Split(CodeBlock, vbCrLf)
    ReDim aStatementLevel(LBound(aStatement) To UBound(aStatement))
    ReDim aStack(LBound(aStatement) To UBound(aStatement))
    For lgStatement = LBound(aStatement) To UBound(aStatement)
        strCode = VBA.Trim$(VBA.LCase$(aStatement(lgStatement)))
        If strCode Like If» & "*" Then
            aStack(lgStatement) = 1
            aStatement(lgStatement) = VBA.Mid$(aStatement(lgStatement), _
                                               VBA.InStr(1, aStatement(lgStatement), If», vbTextCompare) + VBA.Len(If»))

            ' Avoid "=" comparison and apply "==" (Note: will fail for "===" intention!)
            aStatement(lgStatement) = VBA.Replace$(aStatement(lgStatement), "=", "==")

            lgLevel = lgLevel + 1
            aStatementLevel(lgStatement) = lgLevel

        ElseIf strCode Like EndIf» & "*" Then
            aStack(lgStatement) = 0
            aStatement(lgStatement) = "'" 'comment... avoid line
            aStatementLevel(lgStatement) = lgLevel
            lgLevel = lgLevel - 1

        ElseIf strCode Like ElseIf» & " *" Then
            aStack(lgStatement) = 2
            aStatement(lgStatement) = VBA.Mid$(aStatement(lgStatement), _
                                               VBA.InStr(1, aStatement(lgStatement), ElseIf», vbTextCompare) + VBA.Len(ElseIf»))
            aStatementLevel(lgStatement) = lgLevel

        ElseIf strCode Like Else» & "*" Then
            aStack(lgStatement) = 3
            aStatement(lgStatement) = "'" 'comment... avoid line
            aStatementLevel(lgStatement) = lgLevel

        Else ' action code
            aStack(lgStatement) = 4
            aStatementLevel(lgStatement) = -lgLevel
            aStatement(lgStatement) = VBA.Trim$(aStatement(lgStatement))
        End If
    Next lgStatement

    lgStatement = LBound(aStatement)
    lgStatement_End = UBound(aStatement)
    CodeOut = fIf_(aStatement(), _
                   aStatementLevel(), _
                   aStack(), _
                   lgStatement, _
                   lgStatement_End, _
                   Then»:=Then», _
                   If»:=If», _
                   ElseIf»:=ElseIf», _
                   Else»:=Else», _
                   EndIf»:=EndIf», _
                   Then«:=Then«, _
                   If«:=If«, _
                   ElseIf«:=ElseIf«, _
                   Else«:=Else«, _
                   EndIf«:=EndIf«, _
                   Opener«:=Opener«, _
                   Closer«:=Closer«, _
                   Indenter:=Indenter, _
                   Comment:=Comment)

    fIf = CodeOut
End Function

Public Function fIf_(ByRef aStatement() As String, _
                     ByRef aStatementLevel() As Long, _
                     ByRef aStack() As Long, _
                     ByRef lgStatement_Start As Long, _
                     ByVal lgStatement_End As Long, _
                     Optional ByVal Then» As String = " Then", _
                     Optional ByVal If» As String = "If ", _
                     Optional ByVal ElseIf» As String = "ElseIf ", _
                     Optional ByVal Else» As String = "Else", _
                     Optional ByVal EndIf» As String = "End If", _
                     Optional ByVal Then« As String = " {", _
                     Optional ByVal If« As String = "if ", _
                     Optional ByVal ElseIf« As String = "elseif", _
                     Optional ByVal Else« As String = "else", _
                     Optional ByVal EndIf« As String = "}", _
                     Optional ByVal Opener« As String = " {", _
                     Optional ByVal Closer« As String = "} ", _
                     Optional ByVal Indenter As String = vbTab, _
                     Optional ByVal Comment As String = "'") As String
' Translate IF sub-block

    Dim CodeOut As String
    Dim lgStatement As Long
    Dim lgStatement_Block As Long
    Dim lgLevel As Long
    Dim Indent As String
    Dim Indent_ As String

    lgLevel = aStatementLevel(lgStatement_Start)
    Indent = VBA.String(lgLevel - 1, Indenter)
    Indent_ = VBA.String(lgLevel, Indenter)
    CodeOut = vbNullString
    CodeOut = CodeOut & Indent & If« & "(" & aStatement(lgStatement_Start) & ")" & Then« & vbLf

    For lgStatement = (lgStatement_Start + 1) To lgStatement_End
        If aStack(lgStatement) = 1 Then ' if sub-block
            lgStatement_Block = lgStatement
            Do Until (aStack(lgStatement_Block) = 0) And (lgLevel + 1 = aStatementLevel(lgStatement_Block))
                lgStatement_Block = lgStatement_Block + 1
            Loop

            CodeOut = CodeOut & _
                      fIf_(aStatement(), _
                           aStatementLevel(), _
                           aStack(), _
                           lgStatement, _
                           lgStatement_Block, _
                           Then»:=Then», _
                           If»:=If», _
                           ElseIf»:=ElseIf», _
                           Else»:=Else», _
                           EndIf»:=EndIf», _
                           Then«:=Then«, _
                           If«:=If«, _
                           ElseIf«:=ElseIf«, _
                           Else«:=Else«, _
                           EndIf«:=EndIf«, _
                           Opener«:=Opener«, _
                           Closer«:=Closer«, _
                           Indenter:=Indenter)

        ElseIf aStack(lgStatement) = 2 Then 'ElseIf
            CodeOut = CodeOut & Indent & Closer« & " " & ElseIf« & "(" & aStatement(lgStatement) & ") " & Opener« & vbLf
            Do While (aStack(lgStatement) = 0) And (lgLevel = aStatementLevel(lgStatement))
                CodeOut = CodeOut & VBA.String(lgLevel, Indenter) & aStatement(lgStatement) & vbLf
            Loop

        ElseIf aStack(lgStatement) = 3 Then 'Else
            CodeOut = CodeOut & Indent & Closer« & " " & Else« & Opener« & vbLf

        ElseIf aStack(lgStatement) = 0 Then 'EndIf
            CodeOut = CodeOut & Indent & EndIf« & ";" & vbLf

        Else 'ElseIf aStack(lgStatement) = 4 Then 'And aStatementLevel(lgStatement) < 0
            If aStatement(lgStatement)  Comment Then
                CodeOut = CodeOut & Indent_ & vbTab & aStatement(lgStatement) & ";" & vbLf
            End If
        End If
    Next lgStatement

    lgStatement_Start = lgStatement_End
    fIf_ = CodeOut
End Function

Here is a VBA equivalent to JS Push function

Sub sPush()
    Dim aArray() As Variant
    Dim PushVal As Variant
    
    aArray() = Range("$A$1:$B$5").Value2 'fArray2D(Array(1, 2))
    PushVal = Range("$A$6:$B$8").Value2 'fArray2D(Array(3, 4))
    aArray() = fArray2D(Array(1, 2))
    PushVal = fArray2D(Array(3, 4))
    Stop
    fPush aArray(), PushVal
    Stop
End Sub

Public Function fArray2D(ByRef aArray As Variant) As Variant()
    Dim aArrTmp() As Variant
    Dim lgArrayDim1 As Long
    Dim lgArrayDim2 As Long
    Dim lgR As Long
    Dim lgC As Long
    
    On Error GoTo Array2D
    lgArrayDim1 = UBound(aArray, 1) - LBound(aArray, 1) + 1
    lgArrayDim2 = UBound(aArray, 2) - LBound(aArray, 2) + 1

    GoTo ExitProc

Array2D:
    If lgArrayDim2 = 0 Then
        ReDim aArrTmp(LBound(aArray, 1), _
                      LBound(aArray, 1) To UBound(aArray, 1))
        
        For lgC = LBound(aArray, 1) To UBound(aArray, 1)
            aArrTmp(LBound(aArray, 1), lgC) = aArray(lgC)
        Next lgC
        
        fArray2D = aArrTmp()
        Erase aArrTmp()
    End If

ExitProc:
    On Error GoTo 0
End Function

Public Function fPush(ByRef aArray() As Variant, _
                      ByRef PushVal As Variant)
    Dim aArrTmp() As Variant
    Dim lgArrayDim1 As Long
    Dim lgArrayDim2 As Long
    Dim lgPushDim1 As Long
    Dim lgPushDim2 As Long
    Dim lgR As Long
    Dim lgR_Push As Long
    Dim lgC As Long
    
    On Error GoTo ErrControl 'Resume Next
    lgArrayDim1 = UBound(aArray, 1) - LBound(aArray, 1) + 1
    lgArrayDim2 = UBound(aArray, 2) - LBound(aArray, 2) + 1
    lgPushDim1 = UBound(PushVal, 1) - LBound(PushVal, 1) + 1
    lgPushDim2 = UBound(PushVal, 2) - LBound(PushVal, 2) + 1
    
    If lgArrayDim2 = lgPushDim2 Then
        ReDim aArrTmp(LBound(aArray, 1) To UBound(aArray, 1) + 1 + UBound(PushVal, 1) - LBound(PushVal, 1), _
                      LBound(aArray, 2) To UBound(aArray, 2))
        lgR_Push = -1
        For lgR = LBound(aArrTmp, 1) To lgArrayDim1 - (1 - LBound(aArray, 1))
            lgR_Push = lgR_Push + 1
            For lgC = LBound(aArray, 2) To UBound(aArray, 2)
                aArrTmp(lgR, lgC) = aArray(LBound(aArray, 1) + lgR_Push, lgC)
            Next lgC
        Next lgR
        
        lgR_Push = -1
        For lgR = lgArrayDim1 + LBound(aArray, 1) To UBound(aArrTmp, 1)
            lgR_Push = lgR_Push + 1
            For lgC = LBound(PushVal, 2) To UBound(PushVal, 2)
                aArrTmp(lgR, lgC) = PushVal(LBound(PushVal, 1) + lgR_Push, lgC)
            Next lgC
        Next lgR
        aArray() = aArrTmp()
        Erase aArrTmp()
    End If

ExitProc:
    On Error GoTo 0
    Exit Function
ErrControl:
    GoTo ExitProc
End Function
[/sourcecode]	

This blog is a first step materialization of the Big Picture or Master Plan audeser has qeued on.