Attribute VB_Name = "modAppPaths"
Option Explicit

Public strAppPathsLog As String
Public Const APP_PATH_SECTION As String = "CurrentVersion App Paths"
Public Const hKey_CurrentVersion_App_Paths As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"

Public Sub InitAppPathsLog(lstKeys As ListBox, lstPaths As ListBox)
    strAppPathsLog = App.path & "\" & "AppPathsLog.ini"
    GetKeyListFromIni lstKeys, lstPaths
End Sub

'creates current version app paths with access to the usb and dpp dlls
Public Sub CreateAppPaths(lstKeys As ListBox, lstPaths As ListBox)
    On Error Resume Next
    Dim vFilePath As Variant
    Dim strKey As String
    Dim strPath As String
    Dim strCurVerAppPath As String
    
    'locate exe file (use search form)
    Set colSearchResults = Nothing          'clear selections collection
    Set colSearchResults = New Collection
    Load frmSelectPMCA
    frmSelectPMCA.Show vbModal
    If (colSearchResults.Count > 0) Then
        For Each vFilePath In colSearchResults
            strPath = vFilePath             'create key information
            strKey = Dir(strPath)
            
            'check if key must be renamed (if in key list and has different path)
            'this allows for release and debug versions to co-exist
            strKey = CheckKeyListBoxListsEx(strKey, strPath, lstKeys, lstPaths)
            
            'log key and path to listbox/log file for future uninstall
            lstKeys.AddItem strKey
            lstPaths.AddItem strPath
            SaveToIniEx strAppPathsLog, APP_PATH_SECTION, strKey, strPath

            'create app path entry in registry
            strCurVerAppPath = hKey_CurrentVersion_App_Paths & strKey
            CreateNewKey HKEY_LOCAL_MACHINE, strCurVerAppPath
            SetKeyValue HKEY_LOCAL_MACHINE, strCurVerAppPath, "", strPath, REG_SZ
            'create dll path for application in registry
            SetKeyValue HKEY_LOCAL_MACHINE, strCurVerAppPath, "Path", strAmptekCommonFilePath, REG_SZ
        Next
    End If
End Sub

Public Function CheckKeyListBoxLists(strKey As String, strPath As String, _
                                    lstKeys As ListBox, lstPaths As ListBox) As String
    Dim strNewKey As String
    Dim keyIndex As Long
    Dim strPathAtKey As String
    On Error GoTo CheckKeyListBoxLists_Err
    CheckKeyListBoxLists = strKey
    strNewKey = strKey
    keyIndex = GetListObjIndex(lstKeys, strNewKey)
    If (keyIndex >= 0) Then
        strPathAtKey = lstPaths.List(keyIndex)
        If (strPathAtKey <> strPath) Then   'the key must be renamed
            strNewKey = RenameAppPathKey(strNewKey)
        Else
            'if the key was found, and the path values are the same
            'the old key is returned by default
        End If
    Else
        'no key was found, the old key is returned by default
    End If
    CheckKeyListBoxLists = strNewKey
    Exit Function
CheckKeyListBoxLists_Err:
    'if an error occurs checking the keys and the key exists in the key list
    'the old key will be overwritten with the new key path data
    CheckKeyListBoxLists = strKey
End Function

Public Function RenameAppPathKey(strKey As String) As String
    Dim locLeft As Long
    Dim locRight As Long
    Dim strNewKey As String
    Dim fileIndex As Long
    Dim tempFileIdx As Long
    On Error GoTo RenameAppPathKey_Err
    fileIndex = 1               'start file index at 1
    RenameAppPathKey = strKey
    strNewKey = strKey
    'determine if key has been renamed, if so get index and original filename
    locLeft = InStr(1, strNewKey, "[")
    locRight = InStr(1, strNewKey, "]")
    If (locLeft > 0) And (locRight > locLeft + 1) Then  'file has rename index
        tempFileIdx = CLng(Mid(strNewKey, locLeft + 1, (locRight - locLeft) - 1))
        If (tempFileIdx >= fileIndex) Then fileIndex = tempFileIdx + 1
        strNewKey = Left(strNewKey, locLeft - 1) & Mid(strNewKey, locRight + 1)
    End If
    locLeft = InStr(1, strNewKey, ".")  'find first extension delimiter
    If (locLeft > 0) Then   'put file index before delimiter
        strNewKey = Left(strNewKey, locLeft - 1) & "[" & fileIndex & "]" & Mid(strNewKey, locLeft)
    Else                    'put file index at end of file
        strNewKey = strNewKey & "[" & fileIndex & "]"
    End If
    RenameAppPathKey = strNewKey
    Exit Function
RenameAppPathKey_Err:
    RenameAppPathKey = strKey
End Function

Public Function CheckKeyListBoxListsEx(strKey As String, strPath As String, _
                                    lstKeys As ListBox, lstPaths As ListBox) As String
    Dim strOldKey As String
    Dim strNewKey As String
    Dim numRenames As Long
    
    strNewKey = strKey
    numRenames = 0
    Do
        strOldKey = strNewKey
        strNewKey = CheckKeyListBoxLists(strOldKey, strPath, lstKeys, lstPaths)
        numRenames = numRenames + 1
    Loop Until ((strOldKey = strNewKey) Or (numRenames >= 10))
    CheckKeyListBoxListsEx = strNewKey
    Exit Function
CheckKeyListBoxListsEx_Err:
    'if an error occurs checking the keys and the key exists in the key list
    'the old key will be overwritten with the new key path data
    CheckKeyListBoxListsEx = strKey
End Function

'removes current version app paths with access to the usb and dpp dlls
Public Sub UninstallAppPaths(lstKeys As ListBox, lstPaths As ListBox)
    Dim i As Integer
    Dim strKey As String
    Dim strPath As String
    Dim strCurVerAppPath As String
    Dim lRetVal As Long         'result of the key check
    Dim haveAppKey As Boolean
    Dim havePathKey As Boolean

    haveAppKey = False
    havePathKey = False
    For i = (lstKeys.ListCount - 1) To 0 Step -1
        If (lstKeys.Selected(i)) Then              'locate uninstall logged keys
            'select uninstall key from list
            strKey = lstKeys.List(i)               'get key information
            strPath = lstPaths.List(i)

            'create app path entry in registry
            strCurVerAppPath = hKey_CurrentVersion_App_Paths & strKey
            'check if app key exists
            lRetVal = CheckKey(HKEY_LOCAL_MACHINE, strCurVerAppPath)
            If (lRetVal = ERROR_NONE) Then haveAppKey = True
            If (haveAppKey) Then   'remove exe file key
                DeleteKey HKEY_LOCAL_MACHINE, hKey_CurrentVersion_App_Paths, strKey
            End If
            'remove uninstalled key from log lists
            DeleteIniSettingEx strAppPathsLog, APP_PATH_SECTION, strKey
            lstKeys.RemoveItem (i)
            lstPaths.RemoveItem (i)
        End If
    Next
End Sub

'create app path key table
Public Sub GetKeyListFromIni(lstKeys As ListBox, lstPaths As ListBox)
    Dim varAllIni As Variant
    Dim i As Integer
    Dim j As Integer
    Dim idxLRec As Long
    Dim idxLFld As Long
    Dim idxURec As Long
    Dim idxUFld As Long

    lstKeys.Clear
    lstPaths.Clear
    varAllIni = GetAllIniSettingsEx(strAppPathsLog, APP_PATH_SECTION)
    If IsEmpty(varAllIni) Then Exit Sub
    idxLRec = LBound(varAllIni, 1)
    idxLFld = LBound(varAllIni, 2)
    idxURec = UBound(varAllIni, 1)
    idxUFld = UBound(varAllIni, 2)
    For i = idxLRec To idxURec
         lstKeys.AddItem varAllIni(i, 0)
         lstPaths.AddItem varAllIni(i, 1)
    Next
End Sub

Public Function isIdenticalFile(ByVal File1 As String, ByVal File2 As String, _
                            Optional ByteCheck As Boolean = True) As Boolean

    On Error GoTo isIdenticalFile_Err
    
    If Dir(File1) = "" Then Exit Function
    If Dir(File2) = "" Then Exit Function
    Dim lLen1 As Long
    Dim lLen2 As Long
    Dim iFileHnd1 As Integer
    Dim iFileHnd2 As Integer
    Dim byteFile1() As Byte
    Dim byteFile2() As Byte
    Dim i As Long
    Dim lStart As Long
    Dim boolResult As Boolean
    
    lLen1 = FileLen(File1)
    lLen2 = FileLen(File2)
    If lLen1 <> lLen2 Then
        Exit Function
    ElseIf ByteCheck = False Then
        isIdenticalFile = True
        Exit Function
    Else
        iFileHnd1 = FreeFile
        Open File1 For Binary Access Read As #iFileHnd1
        iFileHnd2 = FreeFile
        Open File2 For Binary Access Read As #iFileHnd2
        byteFile1() = InputB(LOF(iFileHnd1), #iFileHnd1)
        byteFile2() = InputB(LOF(iFileHnd2), #iFileHnd2)
        lLen1 = UBound(byteFile1)
        lStart = LBound(byteFile1)
        boolResult = True
        For i = lStart To lLen1
            If byteFile1(i) <> byteFile2(i) Then
                boolResult = False
                Exit For
            End If
        Next
        isIdenticalFile = boolResult
    End If
     
isIdenticalFile_Err:
    If iFileHnd1 > 0 Then Close #iFileHnd1
    If iFileHnd2 > 0 Then Close #iFileHnd2
End Function