VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsVBPBinReporter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' clsVBPBinReporter: Report binary build product for VBP file
Option Explicit


Public Event status(ByVal msg As String)

Public Function header() As String
    header = "VBPPATH" & vbTab & "VBPNAME" & vbTab & "EXETYPE" & vbTab & "EXENAME" & vbTab & "MAJVERS" & vbTab & "MINVERS"
End Function


Public Sub processFile(fil As Scripting.File, rpt As Scripting.TextStream)
    
    Const FUNC_NAME$ = "processFile"
    On Error GoTo errorHandler
    
    Dim filpath As String: filpath = fil.ParentFolder.Path
    Dim filname As String: filname = fil.name
    Dim exetype As String: exetype = "-"
    Dim exename As String: exename = "-"
    Dim majvers As String: majvers = "-"
    Dim minvers As String: minvers = "-"
    
    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)
    
    Dim v As Variant
    For Each v In arr
        
        Dim sLine As String
        sLine = LCase$(v)
        
        If sLine Like "type=*" Then
            exetype = parse1(sLine)
        ElseIf sLine Like "exename32*" Then
            exename = parse1(sLine)
        ElseIf sLine Like "majorver*" Then
            majvers = parse1(sLine)
        ElseIf sLine Like "minorver*" Then
            minvers = parse1(sLine)
        End If
        
    Next v
    
    Call writeRpt(rpt, _
    filpath & vbTab & _
    filname & vbTab & _
    exetype & vbTab & _
    exename & vbTab & _
    majvers & vbTab & _
    minvers & 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 Function parse1(sLine As String) As String
    
    Const Q = """"
    Dim i As Integer
    Dim j As Integer
    
    j = InStrRev(sLine, "\")
    If j > 0 Then
        j = j + 1
    Else
        j = InStr(sLine, "=") + 1
    End If
    
    parse1 = Replace$(Trim$(Mid$(sLine, j)), Q, "")

End Function
