by DiskJunky (16 Submissions)
Category: Registry
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 17th January 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Comprehensive registry access code. Everything from associating file types, putting an app in startup to disabling NT menus, getting cpu usage
API Declarations
'AUTHOR : Eric O'Sullivan
' -----------------------------------------------
'DATE : 11 Januarary 2001
' -----------------------------------------------
'CONTACT: [email protected]
' -----------------------------------------------
'TITLE : Registry Access Module
' -----------------------------------------------
'COMMENTS :
'This was made to retrieve various information
'that is stored in the registry.
'all variables must be declared
Option Explicit
'this module cannot be accessed from outside this project
Option Private Module
'text comparisons are not case sensitive
Option Compare Text
'------------------------------------------------
' API DECLARATIONS
'------------------------------------------------
'api calls to retereive the system and windows folders
Private Declare Function GetSystemDirectory _
Lib "kernel32" _
Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, _
ByVal nSize As Long) _
As Long
Private Declare Function GetWindowsDirectory _
Lib "kernel32" _
Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, _
ByVal nSize As Long) _
As Long
'get the location of the temp directory on the system
Private Declare Function GetTempDirectory _
Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal lBufferLength As Long, _
ByVal strBuffer As String) _
As Long
'get information about the current operating system
Private Declare Function GetVersionEx _
Lib "kernel32" _
Alias "GetVersionExA" _
(ByRef lpVersionInformation As OSVERSIONINFO) _
As Long
'registry api calls
'close an open registry key
Private Declare Function RegCloseKey _
Lib "advapi32.dll" _
(ByVal hKey As Long) _
As Long
'connect with the registry on a remote machine
Private Declare Function RegConnectRegistry _
Lib "advapi32.dll" _
Alias "RegConnectRegistryA" _
(ByVal lpMachineName As String, _
ByVal hKey As Long, _
phkResult As Long) _
As Long
'create a new registry key
Private Declare Function RegCreateKey _
Lib "advapi32.dll" _
Alias "RegCreateKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) _
As Long
'create new - entended
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, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, _
phkResult As Long, _
lpdwDisposition As Long) _
As Long
'delete the specified registry key (also any sub keys
'for non-NT based systems)
Private Declare Function RegDeleteKey _
Lib "advapi32.dll" _
Alias "RegDeleteKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) _
As Long
'delete a registry value
Private Declare Function RegDeleteValue _
Lib "advapi32.dll" _
Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpValueName As String) _
As Long
'return a list of registry sub keys in the specified key
Private Declare Function RegEnumKey _
Lib "advapi32.dll" _
Alias "RegEnumKeyA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
ByVal cbName As Long) _
As Long
Private Declare Function RegEnumKeyEx _
Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
lpftLastWriteTime As FILETIME) _
As Long
'get a list of registry values in a key
VBcoders
' PROCEDURES
Public Sub CreateFileAssociation(ByVal strFileType As String, _
ByVal strTypeDescription As String, _
Optional ByVal strExeName As String, _
Optional ByVal strExePath As String, _
Optional ByVal strIconPath As String)
'This procedure will create a new association for a file. For anyone
'who is unfamiliar with this, this means that if you were to double-
'click on a file with the specified extention, the specified application
'would start. eg, if you were to double click on a .txt file, notepad
'would start and open the file.
'Please note that if you wish to associate an icon, the icon has to be
'a .ico file - no other file types are accepted. If you wish to use an
'icon that is only in your exe (if your distributing you app for
'example), then you need to save the icon as a file. This can be done
'by using;
'
'Call SavePicture(MyControl.Picture, App.Path & "\MyIcon.ico")
'
'Although, please note that the picture must have originally been an
'icon before you tried to save it as one.
Dim lngResult As Long
Dim strFullPath As String
Dim strAppKey As String
'exit procedure if the file type feild is blank
If (strFileType = "") Then
Exit Sub
Else
'if the first character is a dot, then remove it
If Left(strFileType, 1) = "." Then
strFileType = Right(strFileType, Len(strFileType) - 1)
End If
'check to see that the file type is only three characters long
If Len(strFileType) > 3 Then
strFileType = Left(strFileType, 3)
End If
'the type description should be no longer than 25 characters
'(this is not necessary, but it keeps things neat in the registry)
If Len(strTypeDescription) > 25 Then
strTypeDescription = Left(strTypeDescription, 25)
End If
End If
'set the default paths and exe name is they were not specified
If strExeName = "" Then
strExeName = App.EXEName
End If
If strExePath = "" Then
strExePath = App.Path
End If
'make sure that the exename ends in ".exe"
If LCase(Right(strExeName, 4)) <> ".exe" Then
strExeName = strExeName & ".exe"
End If
'get the full path name of the exe
If Right(strExePath, 1) = "\" Then
'if the path already contains a trailing backslash (eg "d:\") then
'don't add one when creating the path
strFullPath = strExePath & strExeName
Else
'insert a backslash to seperate the name from the path
strFullPath = strExePath & "\" & strExeName
End If
'check to make sure that the file exists
If Dir(strFullPath) = "" Then
'there is no file
Exit Sub
End If
'if no icon was specified, then use the icon for the exe
If (strIconPath = "") Or (Dir(strIconPath) = "") Then
strIconPath = strFullPath
End If
'create the file type extention in the registry
Call CreateSubKey(HKEY_CLASSES_ROOT, "." & strFileType)
'create the registry entry in the above sub key that holds the
'sub key with the file path
'eg, "MyApp.Description", "Vb6.Module", "Word.Document"
'Note that a blank entry lable name means a default value for that key,
'if any spaces are in the type description, they are replaced with
'a "." character.
strAppKey = Replace(Left(strExeName, Len(strExeName) - 4) & "." & strTypeDescription, " ", ".")
Call CreateRegString(HKEY_CLASSES_ROOT, _
"." & strFileType, _
"", _
strAppKey)
'create the key that will hold the applications path and type information.
'additional commands can be put into the "Shell\Open\Command" sub key.
'This means that when you right click on the file type, a popup menu
'appears with the Open option. Other options can be inserted into this
'menu by creating sub keys in the Shell key like; "Print\Command",
'"Edit\Command", "Assemble\Command", "Split\Command" etc. where
'the Command sub key contains a [default] entry with a command line
'parameter to an executable file like "C:\Windows\Notepad.exe /p %1"
Call CreateSubKey(HKEY_CLASSES_ROOT, _
strAppKey & "\Shell\Open\Command")
'create the text that describes the file type
Call CreateRegString(HKEY_CLASSES_ROOT, _
strAppKey, _
"", _
strTypeDescription)
'create the command line parameter to open the file type with the
'application specified
Call CreateRegString(HKEY_CLASSES_ROOT, _
strAppKey & "\Shell\Open\Command", _
"", _
strFullPath & " ""%1""")
'create the icon sub key
Call CreateSubKey(HKEY_CLASSES_ROOT, _
strAppKey & "\DefaultIcon")
'create the entry that points to the icon.
If LCase(Right(strIconPath, 3)) = "exe" Then
'get icon from .exe
Call CreateRegString(HKEY_CLASSES_ROOT, _
strAppKey & "\DefaultIcon", _
"", _
strIconPath & ",1")
Else
'get icon from .ico file
Call CreateRegString(HKEY_CLASSES_ROOT, _
strAppKey & "\DefaultIcon", _
"", _
strIconPath & ",0")
End If
End Sub
Public Sub DeleteFileAssociation(ByVal strFileType As String)
'This procedure will remove a file association. It is recommended that
'you only remove an association that your application created, as once
'the association is gone, it cannot be recreated without knowing the
'file type, application involved and the icon assiciated with the file type.
'See CreateFileAssociation for further information.
Dim strSubKeyAssociation As String
'validate the parameter
'make sure that the parameter contains something
If strFileType = "" Then
Exit Sub
End If
'make sure that the first character is a dot (.)
If Left(strFileType, 1) <> "." Then
'insert dot
strFileType = "." & strFileType
End If
'now we check the registry
strSubKeyAssociation = ReadRegString(HKEY_CLASSES_ROOT, _
strFileType, "")
'if there was an error, then exit
If LCase(Left(strSubKeyAssociation, 5)) = "error" Then
Exit Sub
End If
'delete the commands and information about the selected file type
Call DeleteSubKey(HKEY_CLASSES_ROOT, strSubKeyAssociation)
End Sub
Public Sub PutAppInStartup(ByVal strEntryLabel As String, _
Optional ByVal strFilePath As String, _
Optional ByVal blnStartup As StartLoginType = RunAfterLogin, _
Optional ByVal blnOverwrite As Boolean = False)
'This will take an applications full path name and put it into the registry
'to start the program either before or after the login screen in normally
'loaded. If no app path is specified, then by default, it puts the current
'project in to startup after the login screen. Existing enteries are not
'overwritten. You could call this procedure like;
'
'Call PutAppInStartup("MyCoolApp", MyAppsFilePath, RunAfterLogin, False)
'
'or
'
'Call PutAppInStartup("MyCoolApp")
'
'See also RemoveAppFromStartup.
Dim strSubKey As String
Dim strCheck As String
'check to see if a file path was specified
If strFilePath = "" Then
'specifiy the path from the current project
'if the applications path is a root directory, then don't add a
'backslash to the path
If Right(App.Path, 1) = "\" Then
strFilePath = App.Path & App.EXEName & ".exe"
Else
strFilePath = App.Path & "\" & App.EXEName & ".exe"
End If
End If
'check to see if the file exists
If (Dir(strFilePath) = "") Or (strEntryLabel = "") Then
'can't find file. There is no point in making an entry for a file
'that doesn't exist, so exit
Exit Sub
End If
'create the sub key based on the options
If blnStartup = RunAfterLogin Then
'set the app to start after the login screen
strSubKey = STARTUP_AL_SUBKEY
Else
'set the app to run before the login screen
strSubKey = STARTUP_BL_SUBKEY
End If
'if the entry already exists and we don't want to overwrite, then exit
strCheck = ReadRegString(HKEY_LOCAL_MACHINE, _
strSubKey, _
strEntryLabel)
If (Not blnOverwrite) And (Left(strCheck, 5) <> "Error") Then
Exit Sub
End If
'write to the registry
Call CreateRegString(HKEY_LOCAL_MACHINE, _
strSubKey, _
strEntryLabel, _
strFilePath)
End Sub
Public Sub RemoveAppFromStartup(ByVal strEntryLabel As String, _
Optional ByVal blnStartup As StartLoginType = RunAfterLogin)
'This procedure will remove an app from the startup be specifying
'it's label and whether or not the app startsup before or after the
'login screen. Also see the PutInStartup procedure.
Dim strSubKey As String
Dim strCheck As String
'find the sub key depending on the startup gstrMethod
If blnStartup = RunAfterLogin Then
'startup after the login screen [default]
strSubKey = STARTUP_AL_SUBKEY
Else
'startup before the login screen
strSubKey = STARTUP_BL_SUBKEY
End If
'check to see if the entry exists
strCheck = ReadRegString(HKEY_LOCAL_MACHINE, _
strSubKey, _
strEntryLabel)
If Left(strCheck, 5) = "Error" Then
'there was a problem accessing the key, so exit (eg, it might not exist)
Exit Sub
End If
'delete the entry
Call DeleteValue(HKEY_LOCAL_MACHINE, _
strSubKey, _
strEntryLabel)
End Sub
Public Sub CreateSubKey(ByVal enmHive As RegistryHives, _
ByVal strSubKey As String)
'This procedure will create a sub key in the
No comments have been posted about Comprehensive registry access code. Everything from associating file types, putting an app in start. Why not be the first to post a comment about Comprehensive registry access code. Everything from associating file types, putting an app in start.
