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 >
Wrap
Text File
|
1995-08-14
|
6KB
|
202 lines
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