Attribute VB_Name = "modRegistry_Adv" Option Explicit '============================================================================================================= ' ' modRegistry_Adv Module ' ---------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Created On : August 02, 2000 ' Last Update : August 21, 2003 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : Nothing ' ' Description : This module is meant to make it easy to access advanced registry functionality via the Win32 ' API. See each function for more details on how each works. ' ' NOTE : If the user is on Windows NT 4.0 or Windows 2000, the REG_DeleteKey function executes more ' efficiently if Microsoft Internet Explorer 4.x or greater is installed on their computer. ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Type Declaration - GetVersionEx(lpVersionInformation) Private Type OSVERSIONINFO dwOSVersionInfoSize As Long ' Specifies the size, in bytes, of this data structure. Set this member to sizeof(OSVERSIONINFO) before calling the GetVersionEx function. dwMajorVersion As Long ' Identifies the major version number of the operating system. For example, for Windows NT version 3.51, the major version number is 3; and for Windows NT version 4.0, the major version number is 4. dwMinorVersion As Long ' Identifies the minor version number of the operating system. For example, for Windows NT version 3.51, the minor version number is 51; and for Windows NT version 4.0, the minor version number is 0. dwBuildNumber As Long ' Windows NT/2000 : Identifies the build number of the operating system. ' Windows 95/98 : Identifies the build number of the operating system in the low-order word. The high-order word contains the major and minor version numbers. dwPlatformId As Long ' Identifies the operating system platform. This member can be one of the following values: VER_PLATFORM_WIN32s, VER_PLATFORM_WIN32_WINDOWS Win32, or VER_PLATFORM_WIN32_NT szCSDVersion As String * 128 ' Windows NT/2000 : Contains a null-terminated string, such as "Service Pack 3", that indicates the latest Service Pack installed on the system. If no Service Pack has been installed, the string is empty. ' Windows 95/98 : Contains a null-terminated string that provides arbitrary additional information about the operating system. End Type ' Type Declaration - GetVer Private Type DLLVERSIONINFO cbSize As Long ' Size of the structure, in bytes. This member must be filled in before calling the function. dwMajorVersion As Long ' Major version of the DLL. If the DLL's version is 4.0.950, this value will be 4. dwMinorVersion As Long ' Minor version of the DLL. If the DLL's version is 4.0.950, this value will be 0. dwBuildNumber As Long ' Build number of the DLL. If the DLL's version is 4.0.950, this value will be 950. dwPlatformId As Long ' Identifies the platform for which the DLL was built. This can be one of the following values: DLLVER_PLATFORM_WINDOWS, or DLLVER_PLATFORM_NT End Type ' Type Declaration - RegCreateKeyEx(lpSecurityAttributes) Private Type SECURITY_ATTRIBUTES nLength As Long ' Specifies the size, in bytes, of this structure. Set this value to the size of the SECURITY_ATTRIBUTES structure. ' Windows NT/2000 : Some functions that use the SECURITY_ATTRIBUTES structure do not verify the value of the nLength member. However, an application should still set it properly. That ensures current, future, and cross-platform compatibility. lpSecurityDescriptor As Long ' Pointer to a security descriptor for the object that controls the sharing of it. If NULL is specified for this member, the object is assigned the default security descriptor of the calling process. This is not the same as granting access to everyone by assigning a null DACL. The default security descriptor is based on the default DACL of the access token belonging to the calling process. By default, the default DACL in the access token of a process allows access only to the user represented by the access token. If other users must access the object, you can either create a security descriptor with a null DACL, or add ACEs to the DACL that grants access to a group of users. ' Windows 95/98: The lpSecurityDescriptor member of this structure is ignored. bInheritHandle As Long ' Specifies whether the returned handle is inherited when a new process is created. If this member is TRUE, the new process inherits the handle. End Type ' Type Declaration - DeleteEnumKeys Private Type FILETIME dwLowDateTime As Long ' Specifies the low-order 32 bits of the file time. dwHighDateTime As Long ' Specifies the high-order 32 bits of the file time. End Type ' Type Declaration - REG_GetBinary_LONG Private Type BINARYVALUE iID As Integer lngValue As Long End Type ' Enumeration - Operating Systems Public Enum OSTypes OS_Unknown = 0 ' "Unknown" OS_Win32 = 32 ' "Win 32" OS_Win95 = 95 ' "Windows 95" OS_Win98 = 98 ' "Windows 98" OS_WinME = 99 ' "Windows ME" OS_WinNT_351 = 351 ' "Windows NT 3.51" OS_WinNT_40 = 40 ' "Windows NT 4.0" OS_Win2000 = 2000 ' "Windows 2000" OS_WinXP = 50 ' "Windows XP" OS_Win2003 = 2003 ' "Windows Server 2003 family" End Enum ' Enumeration - Registry Keys Public Enum RegistryKeys HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_CONFIG = &H80000005 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_DYN_DATA = &H80000006 ' Windows 95/98 HKEY_PERFORMANCE_DATA = &H80000004 ' Windows NT/2000 End Enum ' Constants - RegSetValueEx(dwType) Private Const REG_NONE = 0 ' No defined value type. Private Const REG_SZ = 1 ' A null-terminated string. It will be a Unicode or ANSI string, depending on whether you use the Unicode or ANSI functions. Private Const REG_EXPAND_SZ = 2 ' A null-terminated string that contains unexpanded references to environment variables (for example, "%PATH%"). It will be a Unicode or ANSI string depending on whether you use the Unicode or ANSI functions. To expand the environment variable references, use the ExpandEnvironmentStrings function. Private Const REG_BINARY = 3 ' Binary data in any form. Private Const REG_DWORD = 4 ' A 32-bit number. Private Const REG_DWORD_LITTLE_ENDIAN = 4 ' A 32-bit number in little-endian format. This is equivalent to REG_DWORD. In little-endian format, a multi-byte value is stored in memory from the lowest byte (the "little end") to the highest byte. For example, the value 0x12345678 is stored as (0x78 0x56 0x34 0x12) in little-endian format. Windows NT/Windows 2000, Windows 95, and Windows 98 are designed to run on little-endian computer architectures. A user may connect to computers that have big-endian architectures, such as some UNIX systems. Private Const REG_DWORD_BIG_ENDIAN = 5 ' A 32-bit number in big-endian format. In big-endian format, a multi-byte value is stored in memory from the highest byte (the "big end") to the lowest byte. For example, the value 0x12345678 is stored as (0x12 0x34 0x56 0x78) in big-endian format. Private Const REG_LINK = 6 ' A Unicode symbolic link. Used internally; applications should not use this type. Private Const REG_MULTI_SZ = 7 ' An array of null-terminated strings, terminated by two null characters. Private Const REG_RESOURCE_LIST = 8 ' A device-driver resource list. Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10 'Private Const REG_QWORD = ? ' A 64-bit number. 'Private Const REG_QWORD_LITTLE_ENDIAN = ? ' A 64-bit number in little-endian format. This is equivalent to REG_QWORD. ' Constants - RegCreateKeyEx(dwOptions) Private Const REG_OPTION_NON_VOLATILE = 0 ' This key is not volatile; this is the default. The information is stored in a file and is preserved when the system is restarted. The RegSaveKey function saves keys that are not volatile. Private Const REG_OPTION_VOLATILE = 1 ' Windows NT/2000 : All keys created by the function are volatile. The information is stored in memory and is not preserved when the corresponding registry hive is unloaded. For HKEY_LOCAL_MACHINE, this occurs when the system is shut down. For registry keys loaded by the RegLoadKey function, this occurs when the corresponding RegUnloadKey is performed. The RegSaveKey function does not save volatile keys. This flag is ignored for keys that already exist. ' Windows 95 : This value is ignored. If REG_OPTION_VOLATILE is specified, the RegCreateKeyEx function creates nonvolatile keys and returns ERROR_SUCCESS. Private Const REG_OPTION_BACKUP_RESTORE = 4 ' Windows NT/2000 : If this flag is set, the function ignores the samDesired parameter and attempts to open the key with the access required to backup or restore the key. If the calling thread has the SE_BACKUP_NAME privilege enabled, the key is opened with ACCESS_SYSTEM_SECURITY and KEY_READ access. If the calling thread has the SE_RESTORE_NAME privilege enabled, the key is opened with ACCESS_SYSTEM_SECURITY and KEY_WRITE access. If both privileges are enabled, the key has the combined accesses for both privileges. ' Constants - RegCreateKeyEx(lpdwDisposition) Private Const REG_CREATED_NEW_KEY = &H1 ' The key did not exist and was created. Private Const REG_OPENED_EXISTING_KEY = &H2 ' The key existed and was simply opened without being changed. ' Constants - RegOpenKeyEx(samDesired) Private Const KEY_CREATE_LINK = 32 ' Permission to create a symbolic link. Private Const KEY_CREATE_SUB_KEY = 4 ' Permission to create subkeys. Private Const KEY_ENUMERATE_SUB_KEYS = 8 ' Permission to enumerate subkeys. Private Const KEY_EXECUTE = 131097 ' Permission for read access. Private Const KEY_NOTIFY = 16 ' Permission for change notification. Private Const KEY_QUERY_VALUE = 1 ' Permission to query subkey data. Private Const KEY_SET_VALUE = 2 ' Permission to set subkey data. Private Const KEY_ALL_ACCESS = 983103 ' Combines the KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, KEY_NOTIFY, KEY_CREATE_SUB_KEY, KEY_CREATE_LINK, and KEY_SET_VALUE access rights, plus all the standard access rights except SYNCHRONIZE. Private Const KEY_READ = 131097 ' Combines the STANDARD_RIGHTS_READ, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and KEY_NOTIFY access rights. Private Const KEY_WRITE = 131078 ' Combines the STANDARD_RIGHTS_WRITE, KEY_SET_VALUE, and KEY_CREATE_SUB_KEY access rights. ' Constants - GetLastErr_Msg Public Const MAX_PATH = 260 Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 ' Constants - GetVersionEx(lpVersionInformation.dwPlatformId) Private Const VER_PLATFORM_WIN32s = 0 ' Win32s on Windows 3.1. Private Const VER_PLATFORM_WIN32_WINDOWS = 1 ' Win32 on Windows 95 or Windows 98. For Windows 95, dwMinorVersion is zero. For Windows 98, dwMinorVersion is greater than zero. Private Const VER_PLATFORM_WIN32_NT = 2 ' Win32 on Windows NT/Windows 2000. ' Variables - GetOS Private Win_OS As OSTypes Private Win_Description As String Private Win_Version As String Private Win_SP As String Private Win_Build As String Private Win_FAILED As Boolean ' Variables - GetVer Private Ver_SHLWAPI As String Private Ver_FAILED As Boolean ' Variables - REG_GetLastError Private ErrLast_Num As Long Private ErrLast_Desc As String ' General Windows API Declarations Private Declare Sub ZeroMemory Lib "KERNEL32.DLL" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long) Private Declare Sub SetLastError Lib "KERNEL32.DLL" (ByVal dwErrCode As Long) Private Declare Function DllGetVersion Lib "SHLWAPI.DLL" (ByRef pdvi As DLLVERSIONINFO) As Long Private Declare Function FreeLibrary Lib "KERNEL32.DLL" (ByVal hLibModule As Long) As Long Private Declare Function FormatMessage Lib "KERNEL32.DLL" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long Private Declare Function GetLastError Lib "KERNEL32.DLL" () As Long Private Declare Function GetModuleHandle Lib "KERNEL32.DLL" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function GetProcAddress Lib "KERNEL32.DLL" (ByVal hModule As Long, ByVal lpProcName As String) As Long Private Declare Function GetVersionEx Lib "KERNEL32.DLL" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long 'BOOL ' Registry Related Windows API Declarations Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByRef lpcName As Long, ByVal lpReserved As Long, ByVal lpClass As String, ByVal lpcClass As Long, ByRef lpftLastWriteTime As FILETIME) 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, ByRef phkResult As Long) As Long Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, ByVal lpcbClass As Long, ByVal lpReserved As Long, ByRef lpcSubKeys As Long, ByVal lpcbMaxSubKeyLen As Long, ByVal lpcbMaxClassLen As Long, ByVal lpcValues As Long, ByVal lpcbMaxValueNameLen As Long, ByVal lpcbMaxValueLen As Long, ByVal lpcbSecurityDescriptor As Long, ByRef lpftLastWriteTime As FILETIME) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Any, ByVal cbData As Long) As Long Private Declare Function SHDeleteEmptyKey Lib "SHLWAPI.DLL" Alias "SHDeleteEmptyKeyA" (ByVal hKey As Long, ByVal pszSubKey As String) As Long Private Declare Function SHDeleteKey Lib "SHLWAPI.DLL" Alias "SHDeleteKeyA" (ByVal hKey As Long, ByVal pszSubKey As String) As Long '_____________________________________________________________________________________________________________ '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' REGISTRY RELATED FUNCTION '_____________________________________________________________________________________________________________ '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= ' REG_ClearErrorInfo ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Subroutine that clears the variables that hold the information about the last error ' that occured. This can be usefull if you do an opperation that you know will cause ' an error, then want to clear the error and test for an error on the next function call. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' (none) ' ' Return: ' ¯¯¯¯¯¯¯ ' (none) ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ ' Call REG_ClearErrorInfo ' '============================================================================================================= Public Sub REG_ClearErrorInfo() On Error Resume Next ErrLast_Num = 0 ErrLast_Desc = "" End Sub '============================================================================================================= ' REG_DeleteEmptyKey ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that only deletes the specified key if it has no subkeys. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to delete ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_DeleteEmptyKey(ByVal hKey As RegistryKeys, ByVal strKey As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim SubKeyCount As Long ' Get which operating system the user is on If CheckOS = False Then Exit Function End If ' Under WinNT4 and Win2000, the RegDeleteKey function will not delete a key if it has subkeys If (Win_OS = OS_WinNT_40) Or (Win_OS = OS_Win2000) Then ReturnValue = RegDeleteKey(hKey, strKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False Else REG_DeleteEmptyKey = True End If ' If the user is on Win95/Win98 then the "RegDeleteKey" API will delete all subkeys too, so ' check if MSIE v4.x or greater is installed so the SHDeleteEmptyKey API can be used. ElseIf (Win_OS = OS_Win95) Or (Win_OS = OS_Win98) Then ' Check if the length of the key passed is too great If Len(strKey) > 255 Then ErrLast_Num = -1 ErrLast_Desc = "Registry key specified to delete is more than the maximum 255 characters." REG_DeleteEmptyKey = False End If ' If the user has IE 4.x or greater installed, OK to use "SHDeleteEmptyKey" ' Otherwise check if the key has any subkeys and delete it if it doesn't If CheckVer = True Then ReturnValue = SHDeleteEmptyKey(hKey, strKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "SHDeleteEmptyKey", ErrLast_Num, ErrLast_Desc, False Else REG_DeleteEmptyKey = True End If Else ' Check to see if the key has no subkeys... and if it doesn't delete it. If REG_GetSubKeyCount(hKey, strKey, SubKeyCount) = False Then Exit Function ElseIf SubKeyCount = 0 Then ReturnValue = RegDeleteKey(hKey, strKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False Else REG_DeleteEmptyKey = True End If Else ErrLast_Num = 5 ErrLast_Desc = "Access is denied." REG_DeleteEmptyKey = False End If End If End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_DeleteEmptyKey = False Exit Function End If End Function '============================================================================================================= ' REG_DeleteKey ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that deletes the specified registry key no mater if it has subkeys or not. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to delete ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' NOTE: ' ¯¯¯¯¯ ' If the user is using WinNT4 or Win2000, this function will execute more efficiently ' if Microsoft Internet Explorer 4.x or greater is installed on the user's machine. ' The reason for this is that if MSIE 4.x or greater is installed, this function has ' access to the "SHDeleteKey" API which deletes the specified key and all it's subkeys ' no matter if it has subkeys or not. If this API is not available, you must ' recursively itterate through all of the specified key's subkeys and check if they do ' not have subkeys themselves... and if they do not delete them. Once all subkeys are ' deleted from under the specified key, the specified key then can be deleted. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_DeleteKey(ByVal hKey As RegistryKeys, ByVal strKey As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long ' Get which operating system the user is on If CheckOS = False Then Exit Function End If ' If the user is on Win2000 or WinNT4 (w/ IE 4.x), then user the "SHDeleteKey" ' API because the "RegDeleteKey" API doesn't delete keys that aren't empty If (Win_OS = OS_WinNT_40) Or (Win_OS = OS_Win2000) Then ' If the user has IE 4.x or greater installed, OK to use "SHDeleteKey" If CheckVer = True Then ReturnValue = SHDeleteKey(hKey, strKey) If ReturnValue = 0 Then REG_DeleteKey = True Else GetLastErr_Msg ReturnValue, "SHDeleteKey", ErrLast_Num, ErrLast_Desc, False REG_DeleteKey = False End If ' If the user does not have IE 4.x or greater installed, enumerate through the ' registry entries below the one specified and delete them one by one. Else If DeleteEnumKeys(hKey, strKey) = False Then REG_DeleteKey = False End If End If ' If on Win95 or Win98 then use the standard "RegDeleteKey" API ElseIf (Win_OS = OS_Win95) Or (Win_OS = OS_Win98) Then ' Check if the length of the key passed is too great If Len(strKey) > 255 Then ErrLast_Num = -1 ErrLast_Desc = "Registry key specified to delete is more than the maximum 255 characters." REG_DeleteKey = False Exit Function End If ' Delete the key ReturnValue = RegDeleteKey(hKey, strKey) If ReturnValue = 0 Then REG_DeleteKey = True Else GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False REG_DeleteKey = False End If End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_DeleteKey = False Exit Function End If End Function '============================================================================================================= ' REG_DeleteValue ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that deletes the specified value under the specified key ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to delete ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_DeleteValue(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Delete the value ReturnValue = RegDeleteValue(TheKey, strValue) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteValue", ErrLast_Num, ErrLast_Desc, False RegCloseKey TheKey GoTo FreeMemory End If ' Close the key that was opened ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If REG_DeleteValue = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_DeleteValue = False Exit Function End If End Function '============================================================================================================= ' REG_GetBinary_BYTE ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that retrieves a Binary value from the specified registry entry. ' * IMPORTANT - This function will return a BYTE ARRAY in the Variant parameter passed. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to get the BYTE data from ' Return_ByteArray Variable that returns the byte array retrieved ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetBinary_BYTE(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByRef Return_ByteArray As Variant) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheType As Long Dim TheSize As Long Dim ByteArray() As Byte ' Clear return variable ReDim Return_ByteArray(0) As Byte ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the size and type of the data If REG_GetDataType(hKey, strKey, strValue, TheType, , TheSize) = False Then GoTo FreeMemory End If ' Make sure that the specified value holds a string value If TheType <> REG_BINARY Then ErrLast_Num = -1 ErrLast_Desc = "Specified Key\Value combination is not a 'Binary' value." GoTo FreeMemory End If ' Resize the buffer to receive the data ReDim ByteArray(TheSize - 1) As Byte ' Get the Byte array ReturnValue = RegQueryValueEx(TheKey, strValue, 0, TheType, ByteArray(0), TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Assign the return value Return_ByteArray = ByteArray REG_GetBinary_BYTE = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetBinary_BYTE = False Exit Function End If End Function '============================================================================================================= ' REG_GetBinary_LONG ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that retrieves a Binary value from the specified registry entry. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to get the Long value from ' Return_Long Variable that returns the retrieved Long value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetBinary_LONG(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByRef Return_Long As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheType As Long Dim TheSize As Long Dim TheInfo As BINARYVALUE Dim MyCounter As Long ' Clear return variable Return_Long = 0 ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the size and type of the data If REG_GetDataType(hKey, strKey, strValue, TheType, , TheSize) = False Then GoTo FreeMemory End If ' Make sure that the specified value holds a string value If TheType <> REG_BINARY Then ErrLast_Num = -1 ErrLast_Desc = "Specified Key\Value combination is not a 'Binary' value." GoTo FreeMemory End If ' Get the Byte array ReturnValue = RegQueryValueEx(TheKey, strValue, 0, TheType, TheInfo, TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Return the data Return_Long = TheInfo.lngValue REG_GetBinary_LONG = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetBinary_LONG = False Exit Function End If End Function '============================================================================================================= ' REG_GetBinary_STR ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Get a string value that has been stored as a binary registry entry. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to retrieve the string data from ' Return_String Variable that returns the string data ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetBinary_STR(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByRef Return_String As String) As Boolean On Error GoTo ErrorTrap Dim ByteArray() As Byte Dim TempVar As Variant ' Clear the return value Return_String = "" ' Get the value from the registry in the form of a BYTE array If REG_GetBinary_BYTE(hKey, strKey, strValue, TempVar) = False Then REG_GetBinary_STR = False Exit Function End If ' Convert the Variant variable to a true BYTE array ByteArray = TempVar ' Assign the BYTE array to a string to get the string value ' (a "String" is basically an array of ASCII characters with values between 0 and 255) Return_String = ByteArray REG_GetBinary_STR = True Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetBinary_STR = False Exit Function End If End Function '============================================================================================================= ' REG_GetDataType ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that inspects a specified registry Key\Value to see what type of entry it is. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to get the data type of ' Return_TypeLNG Optional. Returns the data type as a LONG variable ' Return_TypeSTR Optional. Returns the data type as a STRING variable ' Return_DataSize Optional. Returns the size in BYTEs of the data ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetDataType(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, Optional ByRef Return_TypeLNG As Long, Optional ByRef Return_TypeSTR As String, Optional ByRef Return_DataSize As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the size and type of the data ReturnValue = RegQueryValueEx(TheKey, strValue, 0, Return_TypeLNG, ByVal 0&, Return_DataSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Find what type the return was and return a string equivelent for it Select Case Return_TypeLNG Case REG_SZ ' 1 = A null-terminated string. It will be a Unicode or ANSI string, depending on whether you use the Unicode or ANSI functions. Return_TypeSTR = "String" Case REG_BINARY ' 3 = Binary data in any form. Return_TypeSTR = "Binary" Case REG_DWORD ' 4 = A 32-bit number. Return_TypeSTR = "DWORD" Case REG_DWORD_LITTLE_ENDIAN ' 4 = A 32-bit number in little-endian format. This is equivalent to REG_DWORD. In little-endian format, a multi-byte value is stored in memory from the lowest byte (the "little end") to the highest byte. For example, the value 0x12345678 is stored as (0x78 0x56 0x34 0x12) in little-endian format. ' Windows NT/Windows 2000, Windows 95, and Windows 98 are designed to run on little-endian computer architectures. A user may connect to computers that have big-endian architectures, such as some UNIX systems. Return_TypeSTR = "DWORD - Little Endian" Case REG_DWORD_BIG_ENDIAN ' 5 = A 32-bit number in big-endian format. In big-endian format, a multi-byte value is stored in memory from the highest byte (the "big end") to the lowest byte. For example, the value 0x12345678 is stored as (0x12 0x34 0x56 0x78) in big-endian format. Return_TypeSTR = "DWORD - Big Endian" Case REG_EXPAND_SZ ' 2 = A null-terminated string that contains unexpanded references to environment variables (for example, "%PATH%"). It will be a Unicode or ANSI string depending on whether you use the Unicode or ANSI functions. To expand the environment variable references, use the ExpandEnvironmentStrings function. Return_TypeSTR = "Unexpanded references to an environment variable" Case REG_LINK ' 6 = A Unicode symbolic link. Used internally; applications should not use this type. Return_TypeSTR = "Unicode Symbolic Link" Case REG_MULTI_SZ ' 7 = An array of null-terminated strings, terminated by two null characters. Return_TypeSTR = "String Array" Case REG_RESOURCE_LIST ' 8 = A device-driver resource list. Return_TypeSTR = "Device Driver Resource List" Case REG_NONE ' 0 = No defined value type. Return_TypeSTR = "Undefined Type" Case Else Return_TypeSTR = "Unknown Type" End Select REG_GetDataType = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetDataType = False Exit Function End If End Function '============================================================================================================= ' REG_GetDWORD ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that retrieves a DWORD (Long) value from the specified registry entry. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to retrieve the LONG data value from ' Return_Long Returns the LONG data value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetDWORD(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByRef Return_Long As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheType As Long Dim TheSize As Long ' Clear return variable Return_Long = 0 ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the size and type of the data If REG_GetDataType(hKey, strKey, strValue, TheType, , TheSize) = False Then GoTo FreeMemory End If ' Make sure that the specified value holds a string value If TheType <> REG_DWORD Then ErrLast_Num = -1 ErrLast_Desc = "Specified Key\Value combination is not a 'DWORD' value." GoTo FreeMemory End If ' Get the Long value ReturnValue = RegQueryValueEx(TheKey, strValue, 0, TheType, Return_Long, TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If REG_GetDWORD = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetDWORD = False Exit Function End If End Function '============================================================================================================= ' REG_GetLastError ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that returns the number and description of the last error that occured. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' Return_ErrNum Optional. If an error occured, returns the error number ' Return_ErrDesc Optional. If an error occured, returns the error description ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetLastError(Optional ByRef Return_ErrNum As Long, Optional ByRef Return_ErrDesc As String) As Boolean On Error Resume Next If ErrLast_Num = 0 And ErrLast_Desc = "" Then REG_GetLastError = False Exit Function End If Return_ErrNum = ErrLast_Num Return_ErrDesc = ErrLast_Desc REG_GetLastError = True End Function '============================================================================================================= ' REG_GetString ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that retrieves a String value from the specified registry entry. ' ' NOTE : ' ¯¯¯¯¯¯¯¯¯ ' If you specify "hKey" and "strKey" parameters and then specify the Value as ' vbNullString, the Key's value, or the "Default" value is returned. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to retrieve the string data from ' Return_String Returns the string data ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetString(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByRef Return_String As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheType As Long Dim TheSize As Long ' Clear return variable Return_String = "" ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the size and type of the data If REG_GetDataType(hKey, strKey, strValue, TheType, , TheSize) = False Then GoTo FreeMemory End If ' Make sure that the specified value holds a string value If TheType <> REG_SZ Then ErrLast_Num = -1 ErrLast_Desc = "Specified Key\Value combination is not a 'String' value." GoTo FreeMemory End If ' Initialize the buffer to recieve the string data Return_String = String(MAX_PATH, Chr(0)) ' Get the string value ReturnValue = RegQueryValueEx(TheKey, strValue, 0, TheType, ByVal Return_String, TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If Return_String = Left(Return_String, InStr(Return_String, Chr(0)) - 1) REG_GetString = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetString = False Exit Function End If End Function '============================================================================================================= ' REG_GetSubKeyCount ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that returns the number of subkeys below the specified key. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to delete ' Return_Count Returns the number of sub keys the specified key has ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_GetSubKeyCount(ByVal hKey As RegistryKeys, ByVal strKey As String, ByRef Return_Count As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TestKey As Long Dim TheTime As FILETIME ' Clear the return variable Return_Count = 0 ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TestKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the count of subkeys under the specified key ReturnValue = RegQueryInfoKey(TestKey, vbNullString, 0, 0, Return_Count, 0, 0, 0, 0, 0, 0, TheTime) If ReturnValue = 0 Then REG_GetSubKeyCount = True Else REG_GetSubKeyCount = False GetLastErr_Msg ReturnValue, "RegQueryInfoKey", ErrLast_Num, ErrLast_Desc, False End If REG_GetSubKeyCount = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TestKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False Exit Function End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_GetSubKeyCount = False Exit Function End If End Function '============================================================================================================= ' REG_SaveBinary_BYTE ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that saves a BYTE array to the binary registry Key\Value specified. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to save the byte array to ' DynamicByteArray The dynamic byte array to save - passed in the form of a Variant ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveBinary_BYTE(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByVal DynamicByteArray As Variant) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheSize As Long Dim ByteArray() As Byte Dim TheDisposition As Long ' Make sure the value passed is a valid byte array If VarType(DynamicByteArray) <> vbByte + vbArray Then ErrLast_Num = -1 ErrLast_Desc = "Invalid byte array passed to the 'REG_SaveBinary_BYTE' function" Exit Function End If ' Assign the DYNAMIC byte array to a STANDARD byte array to work with ByteArray = DynamicByteArray ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Test if it was created or opened If TheDisposition = REG_CREATED_NEW_KEY Then Debug.Print "Created new key" ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then Debug.Print "Key already existed" End If ' Get the size of the byte array TheSize = CLng(UBound(ByteArray)) + 1 ' Set the binary value ReturnValue = RegSetValueEx(TheKey, strValue, 0, REG_BINARY, ByteArray(LBound(ByteArray)), TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegSetValueEx", ErrLast_Num, ErrLast_Desc, False End If REG_SaveBinary_BYTE = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveBinary_BYTE = False Exit Function End If End Function '============================================================================================================= ' REG_SaveBinary_LONG ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that saves a LONG value to the binary registry Key\Value specified. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to save the LONG to ' lngData The Long value to save to the binary registry value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveBinary_LONG(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByVal lngData As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheSize As Long Dim TheInfo As BINARYVALUE Dim TheDisposition As Long ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Test if it was created or opened If TheDisposition = REG_CREATED_NEW_KEY Then Debug.Print "Created new key" ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then Debug.Print "Key already existed" End If ' Put the value to be saved in a user defined type (UDT) for storage TheInfo.iID = 1 TheInfo.lngValue = lngData ' Set the binary value ReturnValue = RegSetValueEx(TheKey, strValue, 0, REG_BINARY, TheInfo, LenB(TheInfo)) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegSetValueEx", ErrLast_Num, ErrLast_Desc, False End If REG_SaveBinary_LONG = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveBinary_LONG = False Exit Function End If End Function '============================================================================================================= ' REG_SaveBinary_STR ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that only deletes the specified key if it has no subkeys. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the binary registry value to save the string to ' strData The string data to save tot he binary registry value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveBinary_STR(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByVal strData As String) As Boolean On Error GoTo ErrorTrap Dim ByteArray() As Byte Dim TempVar As Variant ' Assign the BYTE array to a string to pass to the REG_SaveBinary_BYTE function ' (a "String" is basically an array of ASCII characters with values between 0 and 255) ' * NOTE : VB strings are stored internally as unicode BSTR's... meaning that they ' have a character, followed by a NULL character, followed by the next character, ' followed by a NULL character, and so on. So when you do this, you'll notice that ' every other byte in the byte array is 0... representing the NULL character. ByteArray = strData ' Convert the standard byte array to a dynamic byte array and store it in a variant to pass TempVar = ByteArray ' Save the value to the registry as a binary registry entry containing a BYTE array If REG_SaveBinary_BYTE(hKey, strKey, strValue, TempVar) = False Then REG_SaveBinary_STR = False Exit Function End If REG_SaveBinary_STR = True Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveBinary_STR = False Exit Function End If End Function '============================================================================================================= ' REG_SaveDWORD ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that saves a LONG number value to the registry Key\Value specified. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to save the LONG to ' lngData The LONG data to save to the value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveDWORD(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByVal lngData As Long) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheDisposition As Long ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Test if it was created or opened If TheDisposition = REG_CREATED_NEW_KEY Then Debug.Print "Created new key" ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then Debug.Print "Key already existed" End If ' Set the value specified for the key ReturnValue = RegSetValueEx(TheKey, strValue, 0, REG_DWORD, lngData, 4) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegSetValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If REG_SaveDWORD = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveDWORD = False Exit Function End If End Function '============================================================================================================= ' REG_SaveKey ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that creates specified key if it does not yet exist, or modifies it if it does. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to create/modify ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveKey(ByVal hKey As RegistryKeys, ByVal strKey As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheDisposition As Long ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Test if it was created or opened If TheDisposition = REG_CREATED_NEW_KEY Then Debug.Print "Created new key" ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then Debug.Print "Key already existed" End If REG_SaveKey = True FreeMemory: ' Close the key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveKey = False Exit Function End If End Function '============================================================================================================= ' REG_SaveString ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that saves a STRING value to the registry Key\Value specified. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to save the string to ' strData The STRING data to save to the value ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. Call the REG_GetLastError to get the error number and ' description. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Public Function REG_SaveString(ByVal hKey As RegistryKeys, ByVal strKey As String, ByVal strValue As String, ByVal strData As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheDisposition As Long ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Test if it was created or opened If TheDisposition = REG_CREATED_NEW_KEY Then Debug.Print "Created new key" ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then Debug.Print "Key already existed" End If ' Set the value specified for the key ReturnValue = RegSetValueEx(TheKey, strValue, 0, REG_SZ, ByVal strData, Len(strData)) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegSetValueEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If REG_SaveString = True FreeMemory: ' Close the opened key ReturnValue = RegCloseKey(TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 REG_SaveString = False Exit Function End If End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '_____________________________________________________________________________________________________________ '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' FUNCTIONS ONLY USED WITHIN THIS MODULE '_____________________________________________________________________________________________________________ '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Private Function CheckVer() As Boolean On Error GoTo ErrorTrap ' If a previous attempt to get the Version info has failed, don't try again If Ver_FAILED = True Then CheckVer = False Exit Function End If ' If the OS info has not yet been gathered, get it now If Ver_SHLWAPI = "" Then If GetVer = False Then Ver_FAILED = True CheckVer = False Exit Function Else Ver_FAILED = False CheckVer = True End If Else CheckVer = True End If ' Check if the version is at least 4.71 (IE 4.x or later installed) If CSng(Ver_SHLWAPI) >= 4.71 Then CheckVer = True Else CheckVer = False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 CheckVer = False Exit Function End If End Function Private Function GetVer() As Boolean On Error GoTo ErrorTrap Dim Handle_DLL As Long Dim FunctionAddress As Long Dim DLLInfo As DLLVERSIONINFO ' Clear the return value Ver_SHLWAPI = "" ' Get the handle to the file Handle_DLL = GetModuleHandle("SHLWAPI.DLL") If Handle_DLL = 0 Then GetLastErr_Msg , "GetModuleHandle", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Check to see if the function exists in the specified .DLL FunctionAddress = GetProcAddress(Handle_DLL, "DllGetVersion") If FunctionAddress = 0 Then GetLastErr_Msg , "GetProcAddress", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Change all bytes to 0 ZeroMemory DLLInfo, Len(DLLInfo) ' Initialize the memory buffer to put the information into DLLInfo.cbSize = Len(DLLInfo) ' Get the version information If DllGetVersion(DLLInfo) <> 0 Then GetLastErr_Msg , "DllGetVersion", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory Else Ver_SHLWAPI = CStr(DLLInfo.dwMajorVersion) & "." & CStr(DLLInfo.dwMinorVersion) GetVer = True End If FreeMemory: FreeLibrary Handle_DLL Handle_DLL = 0 Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 GetVer = False Resume FreeMemory End If End Function Private Function CheckOS() As Boolean On Error GoTo ErrorTrap ' If a previous attempt to get the OS info has failed, don't try again If Win_FAILED = True Then CheckOS = False Exit Function End If ' If the OS info has not yet been gathered, get it now If Win_Build = "" Or (Win_OS = OS_Unknown) Or Win_Version = "" Then If GetOS = False Then Win_FAILED = True CheckOS = False Exit Function Else Win_FAILED = False CheckOS = True End If Else CheckOS = True End If ' Check if the OS is WinNT v3.51, or Win32s on a 16Bit system. These aren't supported. If (Win_OS = OS_WinNT_351) Or (Win_OS = OS_Win32) Then CheckOS = False End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 CheckOS = False Exit Function End If End Function ' Function to set the windows information variables Private Function GetOS(Optional ByRef Return_ErrNum As Long, Optional ByRef Return_ErrSrc As String, Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim OSinfo As OSVERSIONINFO Dim strDesc As String ' Set return values to default Win_OS = OS_Unknown Win_Description = "" Win_Version = "" Win_Build = "" Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Call the API that returns the Windows version OSinfo.dwOSVersionInfoSize = Len(OSinfo) OSinfo.szCSDVersion = String(128, Chr(0)) If GetVersionEx(OSinfo) = 0 Then Return_ErrNum = Err.LastDllError Return_ErrSrc = "GetVersionEx(..)" Return_ErrDesc = "Failed to successfully get the OS version information" Err.Clear GetOS = False Exit Function End If ' Check the results With OSinfo Select Case .dwPlatformId ' Win32s Case VER_PLATFORM_WIN32s strDesc = "Win 32" Win_OS = OS_Win32 ' Windows 9x Case VER_PLATFORM_WIN32_WINDOWS If .dwMinorVersion = 0 Then strDesc = "Windows 95" Win_OS = OS_Win95 ElseIf .dwMinorVersion = 10 Then strDesc = "Windows 98" Win_OS = OS_Win98 ElseIf .dwMinorVersion = 90 Then strDesc = "Windows ME" Win_OS = OS_WinME Else strDesc = "Unknown" Win_OS = OS_Unknown End If ' Windows NT Family Case VER_PLATFORM_WIN32_NT If .dwMajorVersion = 3 Then strDesc = "Windows NT 3.51" Win_OS = OS_WinNT_351 ElseIf .dwMajorVersion = 4 Then strDesc = "Windows NT 4.0" Win_OS = OS_WinNT_40 ElseIf .dwMajorVersion = 5 Then If .dwMinorVersion = 0 Then strDesc = "Windows 2000" Win_OS = OS_Win2000 ElseIf .dwMinorVersion = 1 Then strDesc = "Windows XP" Win_OS = OS_WinXP ElseIf .dwMinorVersion = 2 Then strDesc = "Windows Server 2003 Family" Win_OS = OS_Win2003 Else strDesc = "Unknown" Win_OS = OS_Unknown End If End If ' Unknown Case Else strDesc = "Unknown" Win_OS = OS_Unknown End Select End With ' Return the information Win_Description = strDesc Win_SP = Trim(Left(OSinfo.szCSDVersion, InStr(OSinfo.szCSDVersion, Chr(0)) - 1)) Win_Version = CStr(OSinfo.dwMajorVersion) & "." & CStr(OSinfo.dwMinorVersion) Select Case Win_OS Case OS_Win95, OS_Win98, OS_WinME Win_Build = CStr(Val("&H" & Right("0000" & Hex(OSinfo.dwBuildNumber), 4))) Case Else Win_Build = CStr(OSinfo.dwBuildNumber) End Select GetOS = True Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear GetOS = False End Function ' This function is meant for WinNT/Win2000 (if the SHLWAPI.DLL version number is less than 4.71). ' If the version is less than 4.71 the function SHDeleteKey, which deletes a key no matter ' if it has sub keys or not, is not available and the DeleteEnumKeys function takes it's place. ' The DeleteEnumKeys function can be called for Win95/Win98 but is not necissary because the ' standard RegDeleteKey function under Win9x will delete a key no matter if it has subkeys or not. Private Function DeleteEnumKeys(ByVal hKey As RegistryKeys, ByVal strKey As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim SubKeyCount As Long Dim UserKey As Long ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, UserKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False Exit Function End If ' Get the count of subkeys under the specified key If REG_GetSubKeyCount(hKey, strKey, SubKeyCount) = False Then DeleteEnumKeys = False GoTo FreeMemory End If ' If the specified registry key has no sub keys, it is save to just delete it If SubKeyCount = 0 Then ReturnValue = RegDeleteKey(hKey, strKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False Else DeleteEnumKeys = True End If GoTo FreeMemory End If ' Loop through all the subkeys and delete them one by one If DeleteKeyLoop(hKey, UserKey, strKey) = False Then DeleteEnumKeys = False Else DeleteEnumKeys = True End If FreeMemory: RegCloseKey UserKey UserKey = 0 Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 DeleteEnumKeys = False Exit Function End If End Function ' This function is a recoursive function meant to go through all the subkeys of the specified key ' and make sure they are empty... then delete them. This function is meant to be called from the ' "DeleteEnumKeys" function for WinNT/Win2000 (if the SHLWAPI.DLL version number is less than ' 4.71). If the version is less than 4.71 the function SHDeleteKey, which deletes a key no matter ' if it has sub keys or not, is not available and the DeleteEnumKeys function takes it's place. ' The DeleteEnumKeys function can be called for Win95/Win98 but is not necissary because the ' standard RegDeleteKey function under Win9x will delete a key no matter if it has subkeys or not. Private Function DeleteKeyLoop(ByVal Base_hKey As Long, ByVal hKey As Long, ByVal strKey As String) As Boolean On Error GoTo ErrorTrap Dim TheKeyPath As String Dim TheIndex As Long Dim SubKeyCount As Long Dim ReturnValue As Long Dim EnumValue As Long Dim TestKey As Long Dim TheKey As String Dim TheTime As FILETIME ' If the key has an extra slash on the end, strip it off If Right(strKey, 1) = "\" Then strKey = Left(strKey, Len(strKey) - 1) End If ' Loop through the keys and delete them one by one While EnumValue = 0 ' Get the name of the subkey by it's index (which is incremented) TheKey = String(MAX_PATH, Chr(0)) EnumValue = RegEnumKeyEx(hKey, 0, TheKey, MAX_PATH, 0, vbNullString, 0, TheTime) ' Pass 0 as the index every time because when we delete subkeys, the index gets messed up. Passing 0 will always get a subkey until there are none left. ' If there are no more subkeys, exit the loop and continue If EnumValue <> 0 Then GoTo Continue End If ' Build a keypath from the given key plus the current subkey TheKeyPath = strKey & "\" & Left(TheKey, InStr(TheKey, Chr(0)) - 1) ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(Base_hKey, TheKeyPath, 0, KEY_ALL_ACCESS, TestKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Get the count of subkeys under the specified key If REG_GetSubKeyCount(Base_hKey, TheKeyPath, SubKeyCount) = False Then DeleteKeyLoop = False GoTo FreeMemory End If ' If the current subkey has no subkeys itself, delete it If SubKeyCount = 0 Then ReturnValue = RegDeleteKey(Base_hKey, TheKeyPath) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' If the current subkey DOES have subkeys, then loop through them and delete them Else If DeleteKeyLoop(Base_hKey, TestKey, TheKeyPath) = False Then ' If the function failed, close the key and exit out RegCloseKey TestKey DeleteKeyLoop = False GoTo FreeMemory End If End If ' Close the key ReturnValue = RegCloseKey(TestKey) TestKey = 0 If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", ErrLast_Num, ErrLast_Desc, False GoTo FreeMemory End If ' Increment the index number to check the next subkey TheIndex = TheIndex + 1 Wend Continue: ' Function succeeded DeleteKeyLoop = True FreeMemory: ' Delete the top level subkey ReturnValue = RegDeleteKey(Base_hKey, strKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteKey", ErrLast_Num, ErrLast_Desc, False Exit Function End If Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 DeleteKeyLoop = False Exit Function End If End Function Private Function GetLastErr_Msg(Optional ByVal ErrorNumber As Long, Optional ByVal LastAPICalled As String = "last", Optional ByRef Return_ErrNum As Long, Optional ByRef Return_ErrDesc As String, Optional ByVal DisplayError As Boolean = False) As Boolean On Error GoTo ErrorTrap Dim ErrMsg As String ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' If no error message is specified then check for one If ErrorNumber = 0 Then ErrorNumber = GetLastError If ErrorNumber = 0 Then GetLastErr_Msg = False Exit Function End If End If ' Allocate a buffer for the error description ErrMsg = String(MAX_PATH + 1, 0) ' Get the error description FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrorNumber, 0, ErrMsg, MAX_PATH + 1, 0 ErrMsg = Left(ErrMsg, InStr(ErrMsg, Chr(0)) - 1) ' Display the error message If DisplayError = True Then MsgBox "An error occured while calling the " & LastAPICalled & " Windows API function." & Chr(13) & "Below is the error information:" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNumber) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, " Windows API Error" End If ' Return the information Return_ErrNum = ErrorNumber Return_ErrDesc = ErrMsg GetLastErr_Msg = True ' Set the last error to 0 (no error) so next time through it doesn't report the same error twice SetLastError 0 Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error ErrLast_Num = Err.Number ErrLast_Desc = Err.Description Err.Clear Err.Number = 0 GetLastErr_Msg = True Exit Function End If End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' DLL Version Numbers: '============================================================================================================= ' ' All but a handful of the programming elements discussed in the Shell and Common ' Controls documentation are contained in three DLLs: Comctl32.dll, Shell32.dll, and ' Shlwapi.dll. Because of ongoing enhancements, different versions of these DLLs ' implement different features. Throughout this document, programming elements are ' marked with a version number. This version number indicates that the programming ' element was first implemented in that version and will also be found in all subsequent ' versions of the DLL. If no version number is specified, the programming element is ' implemented in all versions. The following table outlines the different DLL versions, ' and how they were distributed. ' ' Version DLL Distribution Platform '--------------------------------------------------------------------------------------- ' 4.00 All Microsoft® Windows® 95/Windows NT® 4.0 ' 4.70 All Microsoft® Internet Explorer 3.x ' 4.71 All Microsoft® Internet Explorer 4.0 (See note 2) ' 4.72 All Microsoft® Internet Explorer 4.01 and Windows® 98 (See note 2) ' 5.00 Shlwapi.dll Microsoft® Internet Explorer 5 (See note 3) ' 5.00 Shell32.dll Microsoft® Windows® 2000 (See note 3) ' 5.80 Comctl32.dll Microsoft® Internet Explorer 5 (See note 3) ' 5.81 Comctl32.dll Microsoft® Windows® 2000 (See note 3) '--------------------------------------------------------------------------------------- ' ' Note 1: The 4.00 versions of Shell32.dll and Comctl32.dll are found on the original ' versions of Windows 95 and Windows NT 4. New versions of Commctl.dll were shipped with ' all Internet Explorer releases. Shlwapi.dll first shipped with Internet Explorer 4.0, ' so its first version number is 4.71. The Shell was not updated with the Internet ' Explorer 3.0 release, so Shell32.dll does not have a version 4.70. While Shell32.dll ' versions 4.71 and 4.72 were shipped with the corresponding Internet Explorer releases, ' they were not necessarily installed (see Note 2). For subsequent releases, the version ' numbers for the three DLLs are not identical. In general, you should assume that all ' three DLLs may have different version numbers, and test each one separately. ' ' Note 2: All systems with Internet Explorer 4.0 or 4.01 will have the associated ' version of Comctl32.dll and Shlwapi.dll (4.71 or 4.72, respectively). However, for ' systems prior to Windows 98, Internet Explorer 4.0 and 4.01 can be installed with or ' without the integrated shell. If they are installed with the integrated shell, the ' associated version of Shell32.dll will be installed. If they are installed without the ' integrated shell, Shell32.dll is not updated. In other words, the presence of version ' 4.71 or 4.72 of Comctl32.dll or Shlwapi.dll on a system does not guarantee that ' Shell32.dll has the same version number. All Windows 98 systems have version 4.72 of ' Shell32.dll. ' ' Note 3:Version 5.80 of Comctl32.dll and version 5.0 of Shlwapi.dll are distributed ' with Internet Explorer 5. They will be found on all systems on which Internet ' Explorer 5 is installed, except Windows 2000. Internet Explorer 5 does not update the ' Shell, so version 5.0 of Shell32.dll will not be found on Windows NT, Windows 95, or ' Windows 98 systems. Version 5.0 of Shell32.dll will be distributed with Windows 2000, ' along with version 5.0 of Shlwapi.dll, and version 5.81 of Comctl32.dll. '============================================================================================================= '============================================================================================================= ' "WINVER" - Version Numbers & Descriptions: '============================================================================================================= ' ' Version Description '--------------------------------------------------------------------------------------- ' 0x0200 The application will be compatible with Comctl32.dll and Shell32.dll version ' 4.00 and later. The application will not be able to implement features that ' were added after version 4.00 of Comctl32.dll. ' 0x0300 The application will be compatible with Comctl32.dll and Shell32.dll version ' 4.70 and later. The application will not be able to implement features that ' were added after version 4.70 of Comctl32.dll. ' 0x0400 The application will be compatible with Comctl32.dll and Shell32.dll version ' 4.71 and later. The application will not be able to implement features that ' were added after version 4.71 of Comctl32.dll. ' 0x0401 The application will be compatible with Comctl32.dll and Shell32.dll version ' 4.72 and later. The application will not be able to implement features that ' were added after version 4.72 of Comctl32.dll. ' 0x0500 The application will be compatible with Comctl32.dll version 5.80 and later, ' and Shell32.dll and Shlwapi.dll version 5.0 and later. The application will ' not be able to implement features that were added after version 5.80 of ' Comctl32.dll or version 5.0 of Shell32.dll and Shlwapi.dll. ' 0x0501 The application will be compatible with Comctl32.dll version 5.81 and later ' and Shell32.dll and Shlwapi.dll version 5.0 and later. The application will ' not be able to implement features that were added after version 5.81 of ' Comctl32.dll or version 5.0 of Shell32.dll and Shlwapi.dll. '=============================================================================================================