VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsVBPCntReporter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' clsVBPCntReporter: Report Count of Line types for all modules referenced by a VBP file
Option Explicit

Public Event status(ByVal msg As String)

Public Function header() As String
    header = "VBPPATH" & vbTab & "VBPNAME" & vbTab & "MODNAME" & vbTab & "MODTIME" & vbTab & "MODTYPE" & vbTab & "COD" & vbTab & "GUI" & vbTab & "REF" & vbTab & "CMN" & vbTab & "BLN"
End Function

Public Sub processFile(fil As Scripting.File, rpt As Scripting.TextStream)
    Const FUNC_NAME$ = "processFile"
    On Error GoTo errorHandler
    
    Dim lCOD As Long
    Dim lREF As Long
    
    Dim filpath As String: filpath = fil.ParentFolder.Path
    Dim filname As String: filname = fil.name
    Dim modtype As String
    Dim modname As String
    Dim modpath As String
    
    Dim fileSys As FileSystemObject
    Set fileSys = New FileSystemObject
    
    Dim txtfil As Scripting.TextStream
    Set txtfil = openInputText(fil.Path, fileSys)
    
    Dim s As String
    s = txtfil.ReadAll()
    
    Dim arr() As String
    arr = Split(s, vbCrLf)
    
    lCOD = UBound(arr)
        
    Dim v As Variant
    For Each v In arr
        
        modtype = ""
        Dim sLine As String
        sLine = LCase$(v)
        
        If ( _
        sLine Like "form=*.frm" Or _
        sLine Like "class=*.cls" Or _
        sLine Like "module=*.bas" Or _
        sLine Like "usercontrol=*.ctl" Or _
        sLine Like "propertypage=*.pag") _
        Then
            '----------------------------------------------------
            ' parse the reference for name path etc.
            '----------------------------------------------------
        
            sLine = v
            
            Dim j As Integer
            Dim i As Integer
            
            i = InStr(sLine, "=") + 1
            
            modtype = Left$(sLine, i - 2)
            
            sLine = Trim$(Mid$(sLine, i)) ' object name; path
            
            j = InStrRev(sLine, ";")
            
            If j = 0 Then j = 1 Else j = j + 1
            
            sLine = Trim$(Mid$(sLine, j)) ' object path
            
            j = InStrRev(sLine, "\")
            
            If j = 0 Then j = 1 Else j = j + 1
            
            modname = Trim$(Mid$(sLine, j)) ' file name
            
            If j = 1 Then
                modpath = filpath & "\" & modname
            Else
                modpath = sLine
            End If
            
            '----------------------------------------------------
            ' open file and count its lines
            '----------------------------------------------------
            
            Call countLines(rpt, filpath, filname, modpath, modname, modtype)
      
        Else ' a project directive
            
            If Left$(v, 7) = "Object=" Or Left$(v, 10) = "Reference=" Then
                lREF = lREF + 1
            End If
        End If
    
    Next v
        
    '----------------------------------------------------
    ' report totals for project
    '----------------------------------------------------
    
    Call writeRpt(rpt, _
    filpath & vbTab & _
    fil.name & vbTab & _
    fil.name & vbTab & _
    fil.DateLastModified & vbTab & _
    "Project" & vbTab & _
    lCOD & vbTab & _
    0 & vbTab & _
    lREF & vbTab & _
    0 & vbTab & _
    0 & vbCrLf)

errorHandler:
    
    If Not txtfil Is Nothing Then txtfil.Close
    Set fileSys = Nothing
    Set txtfil = Nothing
    
    If Err Then _
        Err.Raise Err.Number, Description:=TypeName(Me) & "::" & FUNC_NAME$ & " " & _
        vbCrLf & "[" & fil.Path & "]" & _
        vbCrLf & Err.Description
        
End Sub

Private Sub countLines(rpt As Scripting.TextStream, vbppath As String, vbpname As String, modpath As String, modname As String, modtype As String)
    Const FUNC_NAME$ = "countLines"
    On Error GoTo errorHandler
    
    Dim lCMN As Long
    Dim lBLN As Long
    Dim lCOD As Long
    Dim lGUI As Long
    Dim lREF As Long
    
    Dim fileSys As FileSystemObject
    Set fileSys = New FileSystemObject
    
    '----------------------------------------------------
    ' open the module
    '----------------------------------------------------
    
    Dim txtfil As Scripting.TextStream
    Set txtfil = openInputText(modpath, fileSys)
    
    '----------------------------------------------------
    ' parse the module into an array of lines
    '----------------------------------------------------
    
    Dim s As String
    s = txtfil.ReadAll()
    
    Dim arr() As String
    arr = Split(s, vbCrLf)
    
    '----------------------------------------------------
    ' default the line type for forms/ctls to GUI since
    ' the GUI spec is always at the top of the form/ctl.
    '----------------------------------------------------
    
    Dim linetype As String
    
    If modtype = "Form" Or modtype = "UserControl" Then
        linetype = "GUI"
    Else
        linetype = "COD"
    End If
    
    '----------------------------------------------------
    ' get modified date
    '----------------------------------------------------
    
    Dim LastModDate As Date
    Dim fil As Scripting.File
    Set fil = fileSys.GetFile(modpath)
    LastModDate = fil.DateLastModified
    
    '----------------------------------------------------
    ' process each line
    '----------------------------------------------------
    
    Dim l As Long
    l = 1
    
    Dim v As Variant
    For Each v In arr
            
        Dim sLine As String
        sLine = Replace$(v, vbTab, "    ")
        
        Dim trimmedLine As String
        trimmedLine = Trim$(sLine)
        
        If Left$(trimmedLine, 1) = "'" Then
            lCMN = lCMN + 1
        ElseIf Len(trimmedLine) = 0 Then
            lBLN = lBLN + 1
        ElseIf Left$(trimmedLine, 9) = "Object = " Then
            lREF = lREF + 1
        Else
            If linetype = "GUI" Then
                lGUI = lGUI + 1
                If sLine = "End" Then linetype = "COD"
            Else
                lCOD = lCOD + 1
            End If
        End If
    
    Next v
    
    Call writeRpt(rpt, _
    vbppath & vbTab & _
    vbpname & vbTab & _
    modname & vbTab & _
    LastModDate & vbTab & _
    modtype & vbTab & _
    lCOD & vbTab & _
    lGUI & vbTab & _
    lREF & vbTab & _
    lCMN & vbTab & _
    lBLN & vbCrLf)

errorHandler:
    
    If Not txtfil Is Nothing Then txtfil.Close
    Set fileSys = Nothing
    Set fil = Nothing
    Set txtfil = Nothing
    
    If Err Then
        Call writeRpt(rpt, _
        vbppath & vbTab & _
        vbpname & vbTab & _
        modname & vbTab & _
        Now() & vbTab & _
        modpath & ":" & Err.Description & vbTab & _
        lCOD & vbTab & _
        lGUI & vbTab & _
        lREF & vbTab & _
        lCMN & vbTab & _
        lBLN & vbCrLf)
    End If
    
End Sub

