Eintrag in der Systemsteuerung erstellen Mit diesem Code Erstellen Sie einen eigenen Eintrag in der Windows-Systemsteuerung, um Ihr Programm zu starten. Eine Routine zum Entfernen des Eintrags ist ebenfalls vorhanden.
Autor:   Alexander	Bewertung:     [ Jetzt bewerten ]	Views:  20.040
www.alexosoft.de.vu	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 22 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

In unserem heutigem Tipp möchten wir Ihnen zeigen, dass es überhaupt nicht schwer ist, einen Eintrag im Ordner "Systemsteuerung" zu erstellen. Experimentieren Sie nicht mit .CLP Dateien herum. Es geht nämlich ganz einfach oder einfacher als Sie dachten. Benötigt wird hier zunächst ein Modul mit dem Namen modControlPanel mit nachfolgenden Deklarationen:

Option Explicit
 
' Dieses Modul liest und schreibt Registrierungsschlüssel. Im Gegensatz
' zu den internen Registrierungszugriffsmethoden von VB, kann es
' Registrierungsschlüssel mit Zeichenfolgenwerten lesen und schreiben.
 
' ---------------------------------------------------------------
' - API-Deklarationen der Registrierung...
' ---------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32" ( _
  ByVal hKey As Long) As Long
 
Private Declare Function RegCreateKeyEx Lib "advapi32" _
  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, _
  ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  ByRef phkResult As Long, _
  ByRef lpdwDisposition As Long) As Long
 
Private Declare Function RegOpenKeyEx Lib "advapi32" _
  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 RegQueryValueEx Lib "advapi32" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  ByRef lpType As Long, _
  ByVal lpData As String, _
  ByRef lpcbData As Long) As Long
 
Private Declare Function RegSetValueEx Lib "advapi32" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByVal lpData As String, _
  ByVal cbData As Long) As Long
 
Private Declare Function RegSetValueExB Lib "advapi32.dll" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByRef lpData As Byte, _
  ByVal cbData 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 RegCreateKey Lib "advapi32.dll" _
  Alias "RegCreateKeyA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  phkResult As Long) As Long
 
' ---------------------------------------------------------------
' - API-Konstanten der Registrierung...
' ---------------------------------------------------------------
' Registrierungsdatentypen...
Const REG_SZ = 1 ' Null-terminierte Unicode-Zeichenfolge
Const REG_EXPAND_SZ = 2 ' Null-terminierte Unicode-Zeichenfolge
Const REG_BINARY = 3&
Const REG_DWORD = 4 ' 32-Bit-Zahl
 
' Registrierungsschlüssel-Typwerte erstellen...
Const REG_OPTION_NON_VOLATILE = 0 ' Schlüssel bleibt beim Neustart erhalten
 
' Registrierungsschlüssel-Sicherheitsoptionen...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
 
' Registrierungsschlüssel-Stammtypen...
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
 
' Rückgabewert...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0
 
' ---------------------------------------------------------------
' - Sicherheitsattributtyp der Registrierung...
' ---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type
 
Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte

Wie anhand dieser Deklarationen nur unschwer zu erkennen ist, arbeiten wir mit der Windows-Registry. Der Codeabschnitt wurde aus der Entwicklungsumgebung von Microsoft verwendet und ist eine Vorlage. Fügen Sie nun noch ein paar Hilfsfunktionen hinzu:

' -------------------------------------------------------------------------------------------------
' Verwendungsbeispiel - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
' -------------------------------------------------------------------------------------------------
Private Function UpdateKey(KeyRoot As Long, _
  KeyName As String, _
  SubKeyName As String, _
  SubKeyValue As String) As Boolean
 
  Dim rc As Long ' Rückgabe-Code
  Dim hKey As Long ' Zugriffsnummer für Registrierungsschlüssel
  Dim hDepth As Long '
  Dim lpAttr As SECURITY_ATTRIBUTES ' Sicherheitstyp der Registrierung
 
  lpAttr.nLength = 50 ' Sicherheitsattribute auf Standardeinstellungen setzen...
  lpAttr.lpSecurityDescriptor = 0
  lpAttr.bInheritHandle = True
 
  ' ------------------------------------------------------------
  ' - Registrierungsschlüssel erstellen/öffnen...
  ' ------------------------------------------------------------
  rc = RegCreateKeyEx(KeyRoot, KeyName, 0, REG_SZ, _
    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
    hKey, hDepth) ' //KeyRoot//KeyName erstellen/öffnen
  If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Fehler behandeln...
 
  ' ------------------------------------------------------------
  ' - Schlüsselwert erstellen/bearbeiten...
  ' ------------------------------------------------------------
  If (SubKeyValue = "") Then
    ' Für RegSetValueEx() wird zur korrekten Ausführung
    ' ein Leerzeichen benötigt...
    SubKeyValue = " "
  End If
 
  ' Schlüsselwert erstellen/bearbeiten
  rc = RegSetValueEx(hKey, SubKeyName, 0, REG_SZ, _
    SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
  If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Fehler behandeln
 
  ' ------------------------------------------------------------
  ' - Registrierungsschlüssel schließen...
  ' ------------------------------------------------------------
  rc = RegCloseKey(hKey) ' Schlüssel schließen
 
  ' Erfolgreiche Ausführung zurückgeben
  UpdateKey = True
  Exit Function
 
CreateKeyError:
  ' Fehlerrückgabe-Code festlegen
  UpdateKey = False
 
  ' Versuchen, den Schlüssel zu schließen
  rc = RegCloseKey(hKey)
End Function

' Schlüssel erstellen
Private Function CreateKey(SubKey As String)
  Call ParseKey(SubKey, MainKeyHandle)
  If MainKeyHandle Then
    rtn = RegCreateKey(MainKeyHandle, SubKey, hKey)
    If rtn = ERROR_SUCCESS Then
      rtn = RegCloseKey(hKey)
    End If
  End If
End Function

' Schlüssel löschen
Private Function DeleteKey(KeyName As String)
  Call ParseKey(KeyName, MainKeyHandle)
  If MainKeyHandle Then
    rtn = RegDeleteKey(MainKeyHandle, KeyName)
  End If
End Function

' Fehler im Klartext
Private Function ErrorMsg(lErrorCode As Long) As String
  Select Case lErrorCode
    Case 1009, 1015
      ErrorMsg = "The Registry Database is corrupt!"
    Case 2, 1010
      ErrorMsg = "Bad Key Name"
    Case 1011
      ErrorMsg = "Can't Open Key"
    Case 4, 1012
      ErrorMsg = "Can't Read Key"
    Case 5
      ErrorMsg = "Access to this key is denied"
    Case 1013
      ErrorMsg = "Can't Write Key"
    Case 8, 14
      ErrorMsg = "Out of memory"
    Case 87
      ErrorMsg = "Invalid Parameter"
    Case 234
      ErrorMsg = "There is more data than the buffer has been allocated to hold."
    Case Else
      ErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)
  End Select
End Function

' Hauptschlüssel ermitteln
Private Function GetMainKeyHandle(MainKeyName As String) As Long
  Const HKEY_CLASSES_ROOT = &H80000000
  Const HKEY_CURRENT_USER = &H80000001
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const HKEY_USERS = &H80000003
  Const HKEY_PERFORMANCE_DATA = &H80000004
  Const HKEY_CURRENT_CONFIG = &H80000005
  Const HKEY_DYN_DATA = &H80000006
 
  Select Case MainKeyName
    Case "HKEY_CLASSES_ROOT"
      GetMainKeyHandle = HKEY_CLASSES_ROOT
    Case "HKEY_CURRENT_USER"
      GetMainKeyHandle = HKEY_CURRENT_USER
    Case "HKEY_LOCAL_MACHINE"
      GetMainKeyHandle = HKEY_LOCAL_MACHINE
    Case "HKEY_USERS"
      GetMainKeyHandle = HKEY_USERS
    Case "HKEY_PERFORMANCE_DATA"
      GetMainKeyHandle = HKEY_PERFORMANCE_DATA
    Case "HKEY_CURRENT_CONFIG"
      GetMainKeyHandle = HKEY_CURRENT_CONFIG
    Case "HKEY_DYN_DATA"
      GetMainKeyHandle = HKEY_DYN_DATA
  End Select
End Function

' Schlüsselstring "parsen"
Private Sub ParseKey(KeyName As String, Keyhandle As Long)
  rtn = InStr(KeyName, "\")
  If Left(KeyName, 5) <> "HKEY_" Or Right(KeyName, 1) = "\" Then
    MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + KeyName
    Exit Sub
  ElseIf rtn = 0 Then
    Keyhandle = GetMainKeyHandle(KeyName)
    KeyName = ""
  Else
    Keyhandle = GetMainKeyHandle(Left(KeyName, rtn - 1))
    KeyName = Right(KeyName, Len(KeyName) - rtn)
  End If
End Sub

' Wert schreiben
Private Function SetBinaryValue(SubKey As String, Entry As String, _
  Value As String, Optional ByVal DisplayErrorMsg As Boolean = True)
 
  Dim i As Long
 
  Call ParseKey(SubKey, MainKeyHandle)
  If MainKeyHandle Then
    rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey)
    If rtn = ERROR_SUCCESS Then
      lDataSize = Len(Value)
      ReDim ByteArray(lDataSize)
      For i = 1 To lDataSize
        ByteArray(i) = Asc(Mid$(Value, i, 1))
      Next
      rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize)
      If Not rtn = ERROR_SUCCESS Then
        If DisplayErrorMsg = True Then
          MsgBox ErrorMsg(rtn)
        End If
      End If
      rtn = RegCloseKey(hKey)
    Else
      If DisplayErrorMsg = True Then
        MsgBox ErrorMsg(rtn)
      End If
    End If
  End If
End Function

Was jetzt noch fehlt sind die beiden Prozeduren zum Erstellen und Löschen des Eintrags in der Systemsteuerung von Windows.

' Hier die Funktion zum erstellen eines Eintrags in die Systemsteuerung.
Public Function CreateEntryToSystemPanel(GUID As String, _
  Titel As String, _
  ToolTipText As String, _
  IconDatei As String, _
  FileToOpen As String)
 
  ' Einstellungen für den Eintrag festlegen
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID, "", Titel
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID, "InfoTip", ToolTipText
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\DefaultIcon", "", IconDatei
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\InProcServer32", "", "shell32.dll"
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\InProcServer32", "ThreadingModel", "Apartment"
  UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\Shell\Open\Command", "", FileToOpen
 
  ' Eintrag in die Liste "aktivieren"
  Dim sKey As String
  sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\"
 
  UpdateKey HKEY_LOCAL_MACHINE, sKey & "Desktop\NameSpace\" & GUID, "", ""
  UpdateKey HKEY_LOCAL_MACHINE, sKey & "ControlPanel\NameSpace\" & GUID, "", ""
  CreateKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder"
  SetBinaryValue "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder", _
    "Attributes", Chr$(&H0) + Chr$(&H0) + Chr$(&H0) + Chr$(&H0)
End Function

' Funktion zum Entfernen des Eintrags aus der Systemsteuerung
Public Function DeleteEntryFromSystemPanel(GUID As String)
  Dim sKey As String
  sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\"
 
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\DefaultIcon"
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\InProcServer32"
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\Shell\Open\Command"
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellEx\PropertySheetHandlers\" & GUID & ""
  DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder"
  DeleteKey "HKEY_LOCAL_MACHINE\" & sKey & "\Desktop\NameSpace\" & GUID
  DeleteKey "HKEY_LOCAL_MACHINE\" & sKey & "\ControlPanel\NameSpace\" & GUID
End Function

Das wär's. Viele Funktionen, um nur ein paar Registrierungseinträge zu erstellen und wieder zu löschen. Aber das hat sich gelohnt. Sie können nun einfach und schnell Einträge zu der Systemsteuerung hinzufügen.

Ein Beispiel für die Anwendung:

' Eintrag in der Systemsteuerung erstellen
CreateEntryToSystemPanel "{9d6D8ED6-116D-4D4E-B1C2-87098DB509BA}", _
  "Tipp: Eintrag in die Systemsteuerung", _
  "Cool. Meine Anwendung in der Systemsteuerung", _
  App.Path & "\" & App.EXEName & ".exe,0", _
  App.Path & "\" & App.EXEName & ".exe -options"

Zuerst muss ein so genannter GUID übergeben werden. Hier:

{9d6D8ED6-116D-4D4E-B1C2-87098DB509BA}

Dann wird der Titel für den Eintrag eingegeben, dann der ToolTipText und nun das Icon. Hier können Sie bspw. auch eine .ICO-Datei angeben! Wenn Sie hingegen das Icon Ihrer Anwendung haben möchten, geben Sie erst den Pfad zu der Datei an und dann ",0". Damit wird das erste Icon Ihrer Anwendung dargestellt. Falls Sie mehr als ein Icon in Ihrer Anwendung integriert haben, so können Sie die mit dieser Funktion einbinden. Schließlich gibt man die Datei an, die geöffnet werden soll. Durch einen zusätzliche Parameterangabe können Sie sogar herausfinden, ob Ihr Programm von der Systemsteuerung startet wurde.

' Eintrag in der Systemsteuerung wieder löschen
DeleteEntryFromSystemPanel "{9d6D8ED6-116D-4D4E-B1C2-87098DB509BA}"

Hinweis:
Beachten Sie, dass in der Systemsteuerung nur dann das korrekte Icon angezeigt wird, wenn Sie Ihr Projekt als EXE ausführen!

Tipp:
Wie man eine korrekte GUID ermitteln kann, zeigt dieser Tipp:
 Erzeugen einer eindeutigen 128-Bit Ganzzahl