Visual Basic Registry Routines
RegEnumValue: Enumerate Registered Shared DLLs
     
Posted:   Sunday February 23, 2003
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

RegEnumKeyEx: Retrieve the Registered File Associations
     
 Prerequisites
None.

The ShareDLL file provided on the VBnet Dev Resources Tools page contains a Microsoft unsupported tool for displaying - albeit one line at a time - the amount of data in the SharedDLLs registry key.

Shrdll.exe is a command-line tool that helps support professionals and their customers understand the state of the SharedDlls registry key and can be a sys admin's best friend when applications won't install with an 'error writing to the registry' error. Because registry keys in Windows 95 cannot be larger than 64K, it is possible that applications will fail to install if they are writing too much to a registry key this is already practically full. HKEY_LOCAL_MACHINE \ SOFTWARE \ Microsoft \ Windows \ CurrentVersion \ SharedDLLs is the registry key where this is most likely to occur. It also determines which entries in the SharedDLLs key point to files that have been moved or no longer exist and provides for removing those entries to free up registry key space.

The Microsoft utility is also useful under any 32-bit Windows version to simply clean the SharedDLLs key of entries left after the uninstall of applications. I've used it since Windows 95 on 95, NT4, 2000 and XP with absolutely no negative impact, however for those interested here is Microsoft's published info, dated May 14, 2001:


Depending on the platform, checks are performed at the beginning of Setup to ensure that the registry does not overflow. There are two aspects of the registry that can affect Setup in this regard:

  • The total space available for entering new keys and values. If there is not enough space available, Setup might need to increase the registry size.
  • The size of individual registry keys.

Microsoft Windows 2000
There are no known issues.

Microsoft Windows NT 4.0
There is no limitation on the size of individual registry keys, but Windows NT 4.0 cannot dynamically increase the overall size of the registry. If the registry needs to increase, a warning appears and you have to restart your computer.

Microsoft Windows 98
There are no known issues. There is no 64K registry key limitation and Windows 98 does not require you to restart to increase the size of the registry.

Microsoft Windows 95
No individual registry key can be larger than 64K. Windows 95 can dynamically increase the registry without restarting.


This page is more a demo of how to use the registry than anything particularly useful, other than showing all Shared DLL files in one view, rather than one at a time. It shows how to enumerate the entries under the SharedDLLs key, how to retrieve the value associated with each entry, as well as how to determine if the file specified actually exists, and by extension, whether that entry could be safely deleted. The code does not delete the superfluous entries.

The values shown in the second column represents the DLL usage count. Installation program should keep track of shared DLLs; when installing an application that uses shared DLLs, it should increment the use counter for the DLL in the registry. When removing an application, it should decrement the use counter. If the result is zero, the user should be given the option of deleting the DLL. Interestingly, QuickTime mucks around with the registry - the QTPlugin.ocx entry is not deleted when the QuickTime is uninstalled, and pretty well sets itself such it will never be removed from the SharedDLLs key by setting its usage count at 998!

 BAS Module Code
None.

 Form Code
Add a single command button (Command1) and a listview (Listview1) to a form. The code uses the VB6 listview, so VB4/5 users will need to change the library reference ListView1_ColumnClick declare:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2
Private Const INVALID_HANDLE_VALUE = -1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_DWORD As Long = &H4 '32-bit number
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_PATH As Long = 260
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
  
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, _
   ByVal lpSubKey As String, _
   ByVal ulOptions As Long, _
   ByVal samDesired As Long, _
   phkResult As Long) As Long
   
Private Declare Function RegEnumValue Lib "advapi32.dll" _
   Alias "RegEnumValueA" _
  (ByVal hKey As Long, _
   ByVal dwIndex As Long, _
   ByVal lpValueName As String, _
   lpcbValueName As Long, _
   ByVal lpReserved As Long, _
   lpType As Long, _
   lpData As Any, _
   lpcbData As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
  (ByVal hKey As Long, _
   ByVal lpValueName As String, _
   ByVal lpReserved As Long, _
   lpType As Long, _
   lpData As Any, _
   lpcbData As Long) As Long
   
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long
  
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long



Private Sub Form_Load()

   With ListView1
      .ColumnHeaders.Add , , "Shared DLL Files"
      .ColumnHeaders.Add , , "Usage"
      .ColumnHeaders.Add , , "File Exists"
     
      .View = lvwReport
      .FullRowSelect = True
      .AllowColumnReorder = True
      .LabelEdit = lvwManual

   End With
      
   Command1.Caption = "Shared DLL Info"
   
End Sub


Private Sub Command1_Click()

   Dim hKey As Long
   Dim sKey As String
   Dim dwIndex As Long
   Dim sValueName As String * MAX_PATH
   Dim dwKeyType As Long
   Dim sData As String * MAX_PATH
   Dim dwValueNameSize As Long
   Dim dwDataSize As Long
   Dim dwDataUsage As Long
   Dim itmx As ListItem
   
  'obtain a handle to the key
   sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDLLs"
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey)
   
  'if valid
   If hKey <> 0 Then
        
     'initialize enum values
      dwIndex = 0
      dwValueNameSize = MAX_PATH
      dwDataSize = MAX_PATH
      
     'reduce flicker while updating
      ListView1.Visible = False
      
     'enumerate all keys under \SharedDLLs
      Do While RegEnumValue(hKey, _
                            dwIndex, _
                            sValueName, _
                            dwValueNameSize, _
                            0, _
                            dwKeyType, _
                            ByVal sData, _
                            dwDataSize) = ERROR_SUCCESS
         
            
        'retrieve the dword value
        'representing the usage
        'of a particular file
         Call RegQueryValueEx(hKey, _
                              sValueName, _
                              0&, _
                              REG_DWORD, _
                              dwDataUsage, _
                              4)

        'add data to the listview
         Set itmx = ListView1.ListItems.Add(, , TrimNull(sValueName))
         itmx.SubItems(1) = dwDataUsage
         itmx.SubItems(2) = FileExists(sValueName)
       
        'reset variables for next call
         dwValueNameSize = MAX_PATH
         dwDataSize = MAX_PATH
         dwIndex = dwIndex + 1
      
      Loop
      
      Call RegCloseKey(hKey)
      Call lvAutosizeControl(ListView1)
      
      ListView1.ColumnHeaders(1).Text = "Shared DLL Files (" & _
                                        ListView1.ListItems.Count & " entries)"
      ListView1.Visible = True
     
   End If

End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

   ListView1.SortKey = ColumnHeader.Index - 1
   ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
   ListView1.Sorted = True
   
End Sub


Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

  Dim hSubKey As Long

  If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

  End If

End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function


Private Function FileExists(sSource As String) As Boolean

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   
   hFile = FindFirstFile(sSource, WFD)
   FileExists = hFile <> INVALID_HANDLE_VALUE
   
   Call FindClose(hFile)
   
End Function


Private Sub lvAutosizeControl(lv As ListView)

  'Size each column based on the maximum of
  'EITHER the ColumnHeader text width, or,
  'if the items below it are wider, the
  'widest list item in the column
   Dim col2adjust As Long

   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
   
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)
   Next
   
End Sub
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter