'Pfad Rausfinden
  Dim Pfad As String
 
  Pfad = App.Path
 
  If Not Right(Pfad, 1) = "\" Then Pfad = Pfad & "\"
 
'Pfadname Reinfügen
  txtProgramm.Text = Pfad & App.EXEName & ".exe"
 
'Autostart hinzufügen
  Dim Auto As cAutostart
  Set Auto = New cAutostart
 
  Dim strDescr As String
  Dim intPos As Integer
 
  intPos = InStrRev(strFile, "\")
  strDescr = Mid(strFile, intPos + 1, Len(strFile))
 
  On Error GoTo errHandler
 
  Call Auto.SetAutoRun(strDescr, strFile)
 
  Set Auto = Nothing
 
  Exit Sub
 
errHandler:
  MsgBox "Fehler: " & Err.Description
  Err.Clear

Option Explicit
 
'zunächst die benötigten API-Deklarationen
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  ByVal lpSubKey As String, ByVal ulOptions As Long, _
  ByVal samDesired As Long, phkResult As Long) As Long
 
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long
 
Private Declare Function RegSetValueEx_String Lib _
  "advapi32.dll" 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 RegDeleteValue Lib _
  "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As _
  Long, ByVal lpValueName As String) As Long
 
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
 
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_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE _
  Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY Or KEY_CREATE_LINK
 
Const ERROR_SUCCESS = 0&
 
Const REG_NONE = 0
Const REG_SZ = 1
 
'Anwendung in Registry eintragen
'
'sDescr:  Beschreibung/Bezeichnung
'sPath :  Pfad inkl. Dateiname der Anwendung
'===========================================
Public Function SetAutoRun(sDescr As String, _
  sPath As String) As Boolean
 
  Dim lResult As Long
  Dim KeyHandle As Long
  Dim Key As String
 
  Const root = HKEY_CURRENT_USER
  Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
 
  lResult = RegOpenKeyEx(root, Key, 0, KEY_ALL_ACCESS, _
    KeyHandle)
  If lResult <> ERROR_SUCCESS Then
    SetAutoRun = False
    Exit Function
  End If
 
  '+1 für die Null am Ende
  lResult = RegSetValueEx_String(KeyHandle, sDescr, 0, _
    REG_SZ, sPath, Len(sPath) + 1)
 
  RegCloseKey KeyHandle
  SetAutoRun = (lResult = ERROR_SUCCESS)
End Function
 
'aus Registry entfernen
'
'sDescr:  Beschreibung/Bezeichnung
'=================================
Function RemoveAutoRun(sDescr As String) As Boolean
  Dim lResult As Long
  Dim KeyHandle As Long
  Dim Key As String
 
  Const root = HKEY_CURRENT_USER
  Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
 
  lResult = RegOpenKeyEx(root, Key, 0, _
    KEY_ALL_ACCESS, KeyHandle)
  If lResult <> ERROR_SUCCESS Then
    RemoveAutoRun = False
    Exit Function
  End If
  lResult = RegDeleteValue(KeyHandle, sDescr)
  RemoveAutoRun = (lResult = ERROR_SUCCESS)
  RegCloseKey KeyHandle
End Function