Startup.bas #8

Attribute VB_Name = "Startup"
Option Explicit

Dim m_app As Object
Private Const Quote = """"
Public Const MsgTitle = "P4OfficeDiff"

Function FileExists(FileName As String) As Boolean
    On Error GoTo ErrorHandler
    ' get the attributes and ensure that it isn't a directory
    FileExists = (GetAttr(FileName) And vbDirectory) = 0
ErrorHandler:
    ' if an error occurs, this function returns False
End Function

Private Function ConvertSlashes(ByVal path As String) As String
    ' Ensure slashes in path names are using standard DOS char
    Dim i As Integer
    ' For some reason Instr doesn't work here if mixed \ and / appear in string - so we do it the slow way!
    For i = 1 To Len(path)
        If Mid$(path, i, 1) = "/" Then
            ConvertSlashes = Replace(path, "/", "\")
            Exit Function
        End If
    Next
    ConvertSlashes = path
End Function

Public Function StripPath(ByVal FileName As String) As String
    ' Removes any path component from the front of the string
    Dim i As Integer
    
    FileName = ConvertSlashes(FileName)
    StripPath = FileName
    i = Len(FileName)
    While Mid$(FileName, i, 1) <> "\" And i > 0
        i = i - 1
    Wend
    
    If i > 0 Then
        StripPath = Mid$(FileName, i + 1)
    End If
    
End Function

Public Function StripVersion(ByVal FileName As String) As String
    ' Removes any P4V version number from end of string
    Dim i As Integer
    
    FileName = ConvertSlashes(FileName)
    StripVersion = FileName
    i = Len(FileName)
    If i > 0 Then
        Do While Mid$(FileName, i, 1) <> "#"
            i = i - 1
            If i = 0 Then
                Exit Do
            End If
        Loop
    End If
        
    If i > 0 Then
        StripVersion = Left$(FileName, i - 1)
    End If
End Function

Private Function GetVersion(ByVal FileName As String) As Integer
    ' Removes any P4V version number from end of string
    Dim i As Integer, j As Integer
    
    FileName = ConvertSlashes(FileName)
    GetVersion = 0
    i = Len(FileName)
    If i > 0 Then
        Do While Mid$(FileName, i, 1) <> "#"
            i = i - 1
            If i = 0 Then
                Exit Do
            End If
        Loop
    End If
    If i > 0 Then
        Dim digits As String
        digits = ""
        For j = i + 1 To Len(FileName)
            If Mid$(FileName, j, 1) Like "[0-9]" Then
                digits = digits & Mid$(FileName, j, 1)
            End If
        Next
        GetVersion = CInt(digits)
    End If
    
End Function

Private Sub OrderDocnames(File1 As String, File2 As String)
    ' P4V includes revision names in names of temp files - we want earliest first
    Dim tmpFile1 As String
    Dim tmpFile2 As String
    
    tmpFile1 = StripPath(File1)
    tmpFile2 = StripPath(File2)
    If StripVersion(tmpFile1) = StripVersion(tmpFile2) Then
        If GetVersion(tmpFile1) > GetVersion(tmpFile2) Then
            Dim tempfile As String
            tempfile = File1
            File1 = File2
            File2 = tempfile
        End If
    End If
End Sub

Public Sub OpenDocs(File1 As String, File2 As String)
    On Error GoTo error_block
    Dim Step As String
    
    Step = "starting: " & File1 & "|" & File2
    OrderDocnames File1, File2
    Step = "ordered doc nameees"
    If InStr(1, File1, ".do", vbTextCompare) > 0 Then
        Set m_app = CreateObject("word.application")
        m_app.Documents.Open FileName:=File1, ReadOnly:=False
        m_app.Visible = True
        CompareDocs m_app.ActiveDocument, File2
    Else
        Step = "creating object"
        Set m_app = CreateObject("powerpoint.application")
        Step = "created object"
        m_app.Presentations.Open FileName:=File1, ReadOnly:=False
        Step = "opened presentation"
        m_app.Visible = True
        Step = "made visible"
        ComparePresentations m_app.ActivePresentation, File2
    End If
    Exit Sub
    
error_block:
    MsgBox "Error opening document: " & Step & "-" & Err.Description, vbExclamation, MsgTitle
End Sub

Private Sub CompareDocs(Doc As Object, Fname As String)
    On Error GoTo error_block
    Dim Step As String
    ' Office XP constants - need to remove if built with those type libs
    Const wdCompareTargetCurrent = 1
    Const wdMergeTargetCurrent = 1
    Const wdFormattingFromCurrent = 0
    Dim SavedType As WdViewType

    Step = "Getting view"
    SavedType = Doc.activeWindow.View.Type
    If Not (SavedType = wdNormalView Or SavedType = wdPrintView) Then
        Doc.activeWindow.View.Type = wdPrintView
    End If
    
    Step = "Merging"
    If IsVersion2010OrGreater() Then
        Doc.Merge Fname, MergeTarget:=wdMergeTargetCurrent, DetectFormatChanges:=True, UseFormattingFrom:=wdFormattingFromCurrent
    ElseIf IsVersionXPOrGreater() Then
        Doc.Compare Fname, CompareTarget:=wdCompareTargetCurrent, DetectFormatChanges:=True
    Else
        Doc.Compare Fname
    End If

    ' Turn off dirty bit
    Step = "Saving dirty bit"
    If Not Doc.Saved Then
        Doc.Saved = True
    End If
    
    Step = "Saving view"
    If Not (SavedType = wdNormalView Or SavedType = wdPrintView) Then
        Doc.activeWindow.View.Type = SavedType
    End If
    Step = "Activating"
    ActivateDocumentWindow Doc.activeWindow.hwnd
    Exit Sub
    
error_block:
    MsgBox "Error comparing documents: " & Err.Description & " step: " & Step, vbExclamation, MsgTitle
End Sub

Private Sub ComparePresentations(Doc As Object, Fname As String)
    On Error GoTo error_block
    Dim Step As String
    Const wdCompareTargetCurrent = 1
    Const wdMergeTargetCurrent = 1
    Const wdFormattingFromCurrent = 0

    Step = "Getting view"
    
    Step = "Merging"
    If IsVersion2013OrGreater() Then
        Step = "2013 merge"
        Doc.Merge Fname
    ElseIf IsVersion2010OrGreater() Then
        Step = "2010 merge"
        Doc.MergeWithBaseline Fname, ""
    Else
        MsgBox "Powerpoint 2010 or greater is required in order to show differences", vbExclamation, MsgTitle
        Exit Sub
    End If

    ' Turn off dirty bit
    Step = "Saving dirty bit"
    If Not Doc.Saved Then
        Doc.Saved = True
    End If
    
    Step = "Activating"
    ActivateDocumentWindow GetPowerpointWindowHandle
    Exit Sub
    
error_block:
    MsgBox "Error comparing documents: " & Err.Description & " step: " & Step, vbExclamation, MsgTitle
End Sub


Private Function AppVersion() As Integer
    Dim ver As String
    ver = m_app.Version
    AppVersion = CInt(Left$(ver, 2))
End Function

Public Function IsVersionXPOrGreater() As Boolean
    IsVersionXPOrGreater = AppVersion >= 10
End Function

Public Function IsVersion2010OrGreater() As Boolean
    IsVersion2010OrGreater = AppVersion >= 14
End Function

Public Function IsVersion2013OrGreater() As Boolean
    IsVersion2013OrGreater = AppVersion >= 15
End Function

Function GetCommandLine(Optional MaxArgs)
    'Declare variables.
    Dim C, CmdLine, CmdLnLen, InArg, i, NumArgs, InQuotes

    'See if MaxArgs was provided.
    If IsMissing(MaxArgs) Then MaxArgs = 10
    'Make array of the correct size.
    ReDim ArgArray(MaxArgs)
    NumArgs = 0: InArg = False
    'Get command line arguments.
    CmdLine = Command()
    CmdLnLen = Len(CmdLine)
    'Go thru command line one character at a time.
    For i = 1 To CmdLnLen
        C = Mid(CmdLine, i, 1)

        'Test for space or tab.
        If (C <> " " And C <> vbTab) Then
            'Neither space nor tab.
            'Test if already in argument.
            If Not InArg Then
                'New argument begins.
                'Test for too many arguments.
                If NumArgs = MaxArgs Then Exit For
                NumArgs = NumArgs + 1
                InArg = True
            End If
            If C = """" Then
                If InQuotes Then
                    InQuotes = False
                Else
                    InQuotes = True
                End If
            Else
                'Concatenate character to current argument.
                ArgArray(NumArgs) = ArgArray(NumArgs) & C
            End If
        Else
            If InQuotes Then
                ArgArray(NumArgs) = ArgArray(NumArgs) & C
            Else
                'Found a space or tab.
                InArg = False
            End If
        End If
    Next

    'Resize array just enough to hold arguments.
    ReDim Preserve ArgArray(NumArgs)
    ArgArray(0) = NumArgs
    'Return Array in Function name.
    GetCommandLine = ArgArray()
End Function

Public Sub Main()
    On Error GoTo error_block
    Dim Data() As String
    Dim vCommand
    Dim File1 As String
    Dim File2 As String
        
    vCommand = GetCommandLine()
    If vCommand(0) < 2 Then
        frmSelectFiles.Show vbModal
    Else
        File1 = vCommand(1)
        File2 = vCommand(2)
        
        If Not FileExists(File1) Then
            MsgBox "Error: File does not exist '" & File1 & "'", vbExclamation, MsgTitle
        ElseIf Not FileExists(File2) Then
            MsgBox "Error: File does not exist '" & File2 & "'", vbExclamation, MsgTitle
        Else
            OpenDocs File2, File1
        End If
    End If
    Exit Sub
    
error_block:
    MsgBox "Error - please contact rcowham@perforce.com: " & Err.Description, vbExclamation, MsgTitle
End Sub