home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch21code / reginfo.cls < prev    next >
Text File  |  1995-08-14  |  6KB  |  202 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Registration"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. ' Registration class -- REGINFO.CLS
  9. '
  10. '   Properties
  11. '       None
  12. '
  13. '   Methods
  14. '       CheckInstalled
  15. '       CheckRegistrationEntry
  16. '       DeleteKey
  17. '       GetRegisteredList
  18. '
  19. Option Explicit
  20.  
  21. ' Registration APIs used to check entry.
  22. #If Win16 Then
  23. Private Declare Function RegOpenKey Lib "Shell" _
  24.     (ByVal HKeyIn As Long, _
  25.     ByVal LPCSTR As String, _
  26.     HKeyOut As Long) _
  27.     As Long
  28. Private Declare Function RegCloseKey Lib "Shell" _
  29.     (ByVal HKeyIn As Long) _
  30.     As Long
  31. Private Declare Function RegEnumKey Lib "Shell" _
  32.     (ByVal hKey As Long, _
  33.     ByVal dwIndex As Long, _
  34.     ByVal lpName As String, _
  35.     ByVal cbName As Long) _
  36.     As Long
  37. Private Declare Function RegQueryValue Lib "Shell" _
  38.     (ByVal HKeyIn As Long, _
  39.     ByVal SubKey As String, _
  40.     ByVal KeyValue As String, _
  41.     KeyValueLen As Long) _
  42.     As Long
  43. Private Declare Function RegSetValue Lib "Shell" _
  44.     (ByVal HKeyIn As Long, _
  45.     ByVal SubKey As String, _
  46.     ByVal lType As Long, _
  47.     ByVal strNewValue As String, _
  48.     ByVal lIngnored As Long) _
  49.     As Long
  50. Private Declare Sub RegDeleteKey Lib "Shell" _
  51.     (ByVal HKeyIn As Long, _
  52.     ByVal SubKeyName As String)
  53.     
  54. Private Const HKEY_CLASSES_ROOT = &H1
  55. #Else
  56. Private Declare Function RegOpenKey Lib "advapi32" _
  57.     Alias "RegOpenKeyA" _
  58.     (ByVal HKeyIn As Long, _
  59.     ByVal LPCSTR As String, _
  60.     HKeyOut As Long) _
  61.     As Long
  62. Private Declare Function RegCloseKey Lib "advapi32" _
  63.     (ByVal HKeyIn As Long) _
  64.     As Long
  65. Private Declare Function RegEnumKey Lib "advapi32" _
  66.     Alias "RegEnumKeyA" _
  67.     (ByVal hKey As Long, _
  68.     ByVal dwIndex As Long, _
  69.     ByVal lpName As String, _
  70.     ByVal cbName As Long) _
  71.     As Long
  72. Private Declare Function RegQueryValue Lib "advapi32" _
  73.     Alias "RegQueryValueA" _
  74.     (ByVal HKeyIn As Long, _
  75.     ByVal SubKey As String, _
  76.     ByVal KeyValue As String, _
  77.     KeyValueLen As Long) _
  78.     As Long
  79. Private Declare Function RegSetValue Lib "advapi32" _
  80.     Alias "RegSetValueA" _
  81.     (ByVal HKeyIn As Long, _
  82.     ByVal SubKey As String, _
  83.     ByVal lType As Long, _
  84.     ByVal strNewValue As String, _
  85.     ByVal lIngnored As Long) _
  86.     As Long
  87. Private Declare Function RegDeleteKey Lib "advapi32" _
  88.     Alias "RegDeleteKeyA" _
  89.     (ByVal HKeyIn As Long, _
  90.     ByVal SubKeyName As String) _
  91.     As Long
  92.  
  93. Private Const HKEY_CLASSES_ROOT = &H80000001
  94. #End If
  95.  
  96.  
  97. ' Checks the \shell\open entry
  98. ' for an application in the Registry.
  99. Public Sub CheckRegistrationEntry(strApp)
  100.     Dim hkroot As Long, x As Long, lLen As Long
  101.     Dim strKeyID As String, strKeyDesc As String
  102.     Dim strSearchKey As String
  103.     Dim strAppName As String
  104.     ' Get current application path and file name.
  105.     strAppName = App.Path & "\" & App.EXEName & ".EXE"
  106.     lLen = 80
  107.     ' Specify registration key to check.
  108.     strSearchKey = strApp & "\shell\open"
  109.     ' Specify subentry value to check.
  110.     strKeyID = "command"
  111.     ' Initalize key description (value returned by RegQueryValue).
  112.     strKeyDesc = String(lLen, 0)
  113.     ' Open the registration key.
  114.     x = RegOpenKey(HKEY_CLASSES_ROOT, strSearchKey, hkroot)
  115.     ' Get the value of the "command" subentry.
  116.     x = RegQueryValue(hkroot, strKeyID, strKeyDesc, lLen)
  117.     ' Check the value against the current installation.
  118.     If strKeyDesc <> strAppName Then
  119.             ' If it doesn't match, change the registered value.
  120.             x = RegSetValue(hkroot, strKeyID, 1, strAppName, 0)
  121.     End If
  122.     ' Close the registration key.
  123.     x = RegCloseKey(hkroot)
  124. End Sub
  125.  
  126. ' Returns an array of the applications in the
  127. ' system registry.
  128. Public Function GetRegisteredList() As Variant
  129.     Dim hkroot As Long, x As Long, lLen As Long
  130.     ReDim strInstalled(99) As String
  131.     Dim strKeyID As String * 80, strKeyDesc As String * 80, iKeyCount As Integer
  132.     x = RegOpenKey(HKEY_CLASSES_ROOT, "", hkroot)
  133.     lLen = 80
  134.     Do
  135.         strKeyID = String(lLen, 0)
  136.         If RegEnumKey(hkroot, iKeyCount, strKeyID, lLen) = 0 Then
  137.             lLen = 80
  138.             If Mid(strKeyID, 1, 1) <> "." Then
  139.                 strKeyDesc = String(lLen, 0)
  140.                 x = RegQueryValue(hkroot, strKeyID, strKeyDesc, lLen)
  141.                 strInstalled(iKeyCount) = strKeyDesc
  142.                 lLen = 80
  143.             End If
  144.             iKeyCount = iKeyCount + 1
  145.             If iKeyCount > UBound(strInstalled) Then
  146.                 ' Add elements if the array gets full.
  147.                 ReDim Preserve strInstalled(UBound(strInstalled) + 100)
  148.             End If
  149.         Else
  150.             Exit Do
  151.         End If
  152.     Loop
  153.     ' Trim off excess array elements.
  154.     ReDim Preserve strInstalled(iKeyCount)
  155.     x = RegCloseKey(hkroot)
  156. End Function
  157.  
  158. ' Checks if a set of applications are in the Registry.
  159. Public Function CheckInstalled(RequiredList, strNotFound As String) As Variant
  160.     Dim InstalledList As Variant
  161.     Dim InstalledName, RequiredName
  162.     Dim bFound As Boolean
  163.     Dim AppName As String
  164.     InstalledList = GetRegisteredList()
  165.     For Each RequiredName In RequiredList
  166.         For Each InstalledName In InstalledList
  167.             If InStr(InstalledName, RequiredName) Then
  168.                 bFound = True
  169.                 Exit For
  170.             End If
  171.             bFound = False
  172.         Next InstalledName
  173.         ' Build list of application that weren't found.
  174.         If bFound = False Then
  175.             strNotFound = strNotFound & ", " & RequiredName
  176.         End If
  177.     Next RequiredName
  178.     If Len(strNotFound) Then
  179.         strNotFound = Right(strNotFound, Len(strNotFound) - 2)
  180.         CheckInstalled = False
  181.     Else
  182.         CheckInstalled = True
  183.         strNotFound = ""
  184.     End If
  185. End Function
  186.  
  187. ' Deletes a key from the system registry.
  188. Public Sub DeleteKey(Key As String)
  189.     Dim hKey As Long
  190.     Dim strCLSID As String
  191.     Dim lLen As Long
  192.     strCLSID = Space(255)
  193.     If RegQueryValue(HKEY_CLASSES_ROOT, Key, strCLSID, lLen) Then
  194.         ' Delete primary key, using the WinAPI
  195.         RegDeleteKey HKEY_CLASSES_ROOT, Key
  196.         ' Find the CLSID entry for the key
  197.         If RegOpenKey(HKEY_CLASSES_ROOT, "CLSID", hKey) Then
  198.              RegDeleteKey hKey, strCLSID
  199.         End If
  200.     End If
  201. End Sub
  202.