• Home
 · 
• Registry
 · 
• Comprehensive registry access code. Everything from associating file types, putting an app in start

Comprehensive registry access code. Everything from associating file types, putting an app in start

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


Rate Comprehensive registry access code. Everything from associating file types, putting an app in start

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'                   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