VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Registration"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
' Registration class -- REGINFO.CLS
'
'   Properties
'       None
'
'   Methods
'       CheckInstalled
'       CheckRegistrationEntry
'       DeleteKey
'       GetRegisteredList
'
Option Explicit

' Registration APIs used to check entry.
#If Win16 Then
Private Declare Function RegOpenKey Lib "Shell" _
    (ByVal HKeyIn As Long, _
    ByVal LPCSTR As String, _
    HKeyOut As Long) _
    As Long
Private Declare Function RegCloseKey Lib "Shell" _
    (ByVal HKeyIn As Long) _
    As Long
Private Declare Function RegEnumKey Lib "Shell" _
    (ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    ByVal cbName As Long) _
    As Long
Private Declare Function RegQueryValue Lib "Shell" _
    (ByVal HKeyIn As Long, _
    ByVal SubKey As String, _
    ByVal KeyValue As String, _
    KeyValueLen As Long) _
    As Long
Private Declare Function RegSetValue Lib "Shell" _
    (ByVal HKeyIn As Long, _
    ByVal SubKey As String, _
    ByVal lType As Long, _
    ByVal strNewValue As String, _
    ByVal lIngnored As Long) _
    As Long
Private Declare Sub RegDeleteKey Lib "Shell" _
    (ByVal HKeyIn As Long, _
    ByVal SubKeyName As String)
    
Private Const HKEY_CLASSES_ROOT = &H1
#Else
Private Declare Function RegOpenKey Lib "advapi32" _
    Alias "RegOpenKeyA" _
    (ByVal HKeyIn As Long, _
    ByVal LPCSTR As String, _
    HKeyOut As Long) _
    As Long
Private Declare Function RegCloseKey Lib "advapi32" _
    (ByVal HKeyIn As Long) _
    As Long
Private Declare Function RegEnumKey Lib "advapi32" _
    Alias "RegEnumKeyA" _
    (ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    ByVal cbName As Long) _
    As Long
Private Declare Function RegQueryValue Lib "advapi32" _
    Alias "RegQueryValueA" _
    (ByVal HKeyIn As Long, _
    ByVal SubKey As String, _
    ByVal KeyValue As String, _
    KeyValueLen As Long) _
    As Long
Private Declare Function RegSetValue Lib "advapi32" _
    Alias "RegSetValueA" _
    (ByVal HKeyIn As Long, _
    ByVal SubKey As String, _
    ByVal lType As Long, _
    ByVal strNewValue As String, _
    ByVal lIngnored As Long) _
    As Long
Private Declare Function RegDeleteKey Lib "advapi32" _
    Alias "RegDeleteKeyA" _
    (ByVal HKeyIn As Long, _
    ByVal SubKeyName As String) _
    As Long

Private Const HKEY_CLASSES_ROOT = &H80000001
#End If


' Checks the \shell\open entry
' for an application in the Registry.
Public Sub CheckRegistrationEntry(strApp)
    Dim hkroot As Long, x As Long, lLen As Long
    Dim strKeyID As String, strKeyDesc As String
    Dim strSearchKey As String
    Dim strAppName As String
    ' Get current application path and file name.
    strAppName = App.Path & "\" & App.EXEName & ".EXE"
    lLen = 80
    ' Specify registration key to check.
    strSearchKey = strApp & "\shell\open"
    ' Specify subentry value to check.
    strKeyID = "command"
    ' Initalize key description (value returned by RegQueryValue).
    strKeyDesc = String(lLen, 0)
    ' Open the registration key.
    x = RegOpenKey(HKEY_CLASSES_ROOT, strSearchKey, hkroot)
    ' Get the value of the "command" subentry.
    x = RegQueryValue(hkroot, strKeyID, strKeyDesc, lLen)
    ' Check the value against the current installation.
    If strKeyDesc <> strAppName Then
            ' If it doesn't match, change the registered value.
            x = RegSetValue(hkroot, strKeyID, 1, strAppName, 0)
    End If
    ' Close the registration key.
    x = RegCloseKey(hkroot)
End Sub

' Returns an array of the applications in the
' system registry.
Public Function GetRegisteredList() As Variant
    Dim hkroot As Long, x As Long, lLen As Long
    ReDim strInstalled(99) As String
    Dim strKeyID As String * 80, strKeyDesc As String * 80, iKeyCount As Integer
    x = RegOpenKey(HKEY_CLASSES_ROOT, "", hkroot)
    lLen = 80
    Do
        strKeyID = String(lLen, 0)
        If RegEnumKey(hkroot, iKeyCount, strKeyID, lLen) = 0 Then
            lLen = 80
            If Mid(strKeyID, 1, 1) <> "." Then
                strKeyDesc = String(lLen, 0)
                x = RegQueryValue(hkroot, strKeyID, strKeyDesc, lLen)
                strInstalled(iKeyCount) = strKeyDesc
                lLen = 80
            End If
            iKeyCount = iKeyCount + 1
            If iKeyCount > UBound(strInstalled) Then
                ' Add elements if the array gets full.
                ReDim Preserve strInstalled(UBound(strInstalled) + 100)
            End If
        Else
            Exit Do
        End If
    Loop
    ' Trim off excess array elements.
    ReDim Preserve strInstalled(iKeyCount)
    x = RegCloseKey(hkroot)
End Function

' Checks if a set of applications are in the Registry.
Public Function CheckInstalled(RequiredList, strNotFound As String) As Variant
    Dim InstalledList As Variant
    Dim InstalledName, RequiredName
    Dim bFound As Boolean
    Dim AppName As String
    InstalledList = GetRegisteredList()
    For Each RequiredName In RequiredList
        For Each InstalledName In InstalledList
            If InStr(InstalledName, RequiredName) Then
                bFound = True
                Exit For
            End If
            bFound = False
        Next InstalledName
        ' Build list of application that weren't found.
        If bFound = False Then
            strNotFound = strNotFound & ", " & RequiredName
        End If
    Next RequiredName
    If Len(strNotFound) Then
        strNotFound = Right(strNotFound, Len(strNotFound) - 2)
        CheckInstalled = False
    Else
        CheckInstalled = True
        strNotFound = ""
    End If
End Function

' Deletes a key from the system registry.
Public Sub DeleteKey(Key As String)
    Dim hKey As Long
    Dim strCLSID As String
    Dim lLen As Long
    strCLSID = Space(255)
    If RegQueryValue(HKEY_CLASSES_ROOT, Key, strCLSID, lLen) Then
        ' Delete primary key, using the WinAPI
        RegDeleteKey HKEY_CLASSES_ROOT, Key
        ' Find the CLSID entry for the key
        If RegOpenKey(HKEY_CLASSES_ROOT, "CLSID", hKey) Then
             RegDeleteKey hKey, strCLSID
        End If
    End If
End Sub
