Programm in Registry schreiben

cobfreaky

Mitglied
Hallo,

Wie kann ich mein selbst erstelltes VB6 Projekt in die Windows Registry schreiben, sodass es sich bei jedem Systemstart öffnet?

Gruß,
cobfreaky
 
Also hier haben wir erstmal den Entsprächenden Eintrag
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run

Dann benötigen wir folgendes Modul zum schreiben in die Registrierung

Code:
'wird in der Form benötigt:
Public SubKey$
Public Eintrag$
Public Key%


'Fehler oder nicht
Const ERROR_SUCCESS = 0

'Hauptschlüssel
Const MainKey = &H80000000
Public Const HKEY_CLASSES_ROOT = 0
Public Const HKEY_CURRENT_USER = 1
Public Const HKEY_LOCAL_MACHINE = 2
Public Const HKEY_USERS = 3
Public Const HKEY_PERFORMANCE_DATA = 4 '(nur NT)
Public Const HKEY_CURRENT_CONFIG = 5
Public Const HKEY_DYN_DATA = 6


'Zugriffcodes
Const KEY_ALL_ACCESS = &H3F

Public Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8

'Optionen beim Anlegen
Const REG_OPTION_NON_VOLATILE = 0

'Datentypen
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Const REG_RESOURCE_REQUIREMENTS_LIST = 10


'Strukturen
Type Time
   LowTime As Long
   HighTime As Long
End Type


'Sicherheitsstruktur nur zur Deklaration der Funktionen
Type SECURITY_ATTRIBUTES
   Length As Long
   Descriptor As Long
   InheritHandle As Boolean
End Type

'Prototypen aus ADVAPI32
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal sSubKey As String, ByVal lReserved As Long, ByVal lSecurity As Long, hKeyReturn As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Declare Function RegQueryValue Lib "advapi32" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal sValue As String, lReserved As Long, lTyp&, ByVal sData As String, lcbData As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Declare Function RegEnumKey Lib "advapi32" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpname As String, ByVal cbName As Long) As Long
Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal SubKeyIndex As Long, ByVal SubKeyName As String, SubKeyNameSize As Long, Reserved As Long, ByVal Class As String, ClassSize As Long, FileTime As Time) As Long

Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal Name As String, ByVal Reserved As Long, ByVal DataType As Long, ByVal Data As String, ByVal Length As Long) As Long

Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal SubKey As String, ByVal Reserved As Long, ByVal Class As String, ByVal Options As Long, ByVal Access As Long, Security As SECURITY_ATTRIBUTES, hKeyNew As Long, Disposition As Long) As Long
Declare Function RegDeleteValue Lib "advapi32" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal Key As String) As Long
Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long


Sub RegCreate(MainKey%, ByVal Key$)
    b$ = ""
    Do While InStr(Key$, "\")
        c$ = zeichennext$(Key$, "\")
        RegCreateKey MainKey%, b$, c$
        If Len(b$) Then b$ = b$ + "\"
        b$ = b$ + c$
    Loop
    RegCreateKey MainKey%, b$, Key$
End Sub

Sub RegSetValue(KeyIndex%, SubKey As String, Name As String, lTyp&, Wert As String, lByte&)
'KeyIndex=0: HKEY_CLASSES_ROOT
'         1: HKEY_CURRENT_USER
'         2: HKEY_LOCAL_MACHINE
'         3: HKEY_USERS
'         4: HKEY_PERFORMANCE_DATA (nur NT)
'         5: HKEY_CURRENT_CONFIG
'         6: HKEY_DYN_DATA

    lhKey& = MainKey + KeyIndex
    lResult& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_SET_VALUE, lhKeyOpen&)
    If lResult& <> ERROR_SUCCESS Then Exit Sub
    lResult& = RegSetValueEx(lhKeyOpen&, Name, 0, lTyp&, Wert, lByte&)
    'If lResult& <> ERROR_SUCCESS Then (Fehler...)
    RegCloseKey lhKeyOpen&
End Sub

Sub Reg_DeleteValue(KeyIndex%, Key$, sch$)
    lhKey& = MainKey + KeyIndex%
    lResult& = RegOpenKeyEx(lhKey&, Key, 0, KEY_SET_VALUE, lhKeyOpen&)
    If lResult& <> ERROR_SUCCESS Then Exit Sub
    lResult& = RegDeleteValue(lhKeyOpen&, sch$)
    'If lResult& <> ERROR_SUCCESS Then (Fehler...)
    RegCloseKey lhKeyOpen&
End Sub

Sub Reg_DeleteKey(KeyIndex%, Key$)
    lhKey& = MainKey + KeyIndex%
    lResult& = RegDeleteKey(lhKey&, Key$)
    'If lResult& <> ERROR_SUCCESS Then (Fehler...)
End Sub

Function Reg_Exist_Key(KeyIndex%, SubKey As String) As Boolean
    lhKey& = MainKey + KeyIndex
    Reg_Exist_Key = False
    l& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_ALL_ACCESS, lhKeyOpen&)
    'Schlüssel existiert nicht
    If l& <> ERROR_SUCCESS Then Exit Function
    Reg_Exist_Key = True
End Function

Function Reg_Exist_Value(KeyIndex%, SubKey As String, Name As String) As Boolean
    lhKey& = MainKey + KeyIndex
    Reg_Exist_Value = False
    l& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_ALL_ACCESS, lhKeyOpen&)
    'Schlüssel existiert nicht
    If l& <> ERROR_SUCCESS Then Exit Function
    'Wert existiert nicht
    l& = RegQueryValueExNULL(lhKeyOpen&, Name, 0&, lTyp&, 0&, cch&)
    If l& <> ERROR_SUCCESS Then Exit Function
    Reg_Exist_Value = True
End Function

Function Reg_GetValue_Typ(KeyIndex%, SubKey As String, Name As String) As String
    lhKey& = MainKey + KeyIndex
    Reg_GetValue_Typ = ""
    l& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_ALL_ACCESS, lhKeyOpen&)
    If l& <> ERROR_SUCCESS Then Exit Function
    
    l& = RegQueryValueExNULL(lhKeyOpen&, Name, 0&, lTyp&, 0&, cch&)
    If l& <> ERROR_SUCCESS Then Exit Function
    Select Case lTyp&
    Case REG_SZ
        Reg_GetValue_Typ = "STRING"
    Case REG_DWORD
        Reg_GetValue_Typ = "DWORD"
    Case REG_BINARY
        Reg_GetValue_Typ = "BINARY"
    Case Else
        Reg_GetValue_Typ = "?"
    End Select
End Function

Function Reg_GetValue(KeyIndex%, SubKey As String, Name As String) As String
    lhKey& = MainKey + KeyIndex
    Reg_GetValue = ""

    l& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_ALL_ACCESS, lhKeyOpen&): If l& <> ERROR_SUCCESS Then Exit Function
    l& = RegQueryValueExNULL(lhKeyOpen&, Name, 0&, lTyp&, 0&, cch&): If l& <> ERROR_SUCCESS Then Exit Function

    Select Case lTyp&
    Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:
        sValue$ = String(cch& + 1, 0)
        l& = RegQueryValueExString(lhKeyOpen&, Name, 0&, lTyp&, sValue$, cch&): If l& <> ERROR_SUCCESS Then Exit Function
        Reg_GetValue = zeichennext$(Left$(sValue$, cch&), Chr$(0))
    Case REG_DWORD
        l& = RegQueryValueExLong(lhKeyOpen&, Name, 0&, lTyp&, lValue&, cch&): If l& <> ERROR_SUCCESS Then Exit Function
        Reg_GetValue = Trim$(Str$(lValue&))
    Case REG_BINARY
        sValue$ = String(cch& + 1, 0)
        l& = RegQueryValueExString(lhKeyOpen&, Name, 0&, lTyp&, sValue$, cch&): If l& <> ERROR_SUCCESS Then Exit Function
        Reg_GetValue = Left$(sValue$, cch&)
        For iTempInt = 1 To Len(Reg_GetValue)
            s = Asc(Mid$(Reg_GetValue, iTempInt, 1))
            'Binärwerte bringen Probleme,
            'sollte so aber funktionieren !
            temp = ""
            If s = 26 Then temp = "1A "
            If s = 58 Then temp = "3A "
            If s = 74 Then temp = "4A "
            If s = 90 Then temp = "5A "
            If s = 106 Then temp = "6A "
            If s = 122 Then temp = "7A "
            If s = 138 Then temp = "8A "
            If s = 154 Then temp = "9A "
            If temp = "" Then
                sBinaryString = sBinaryString & Format(Hex(Asc(Mid$(Reg_GetValue, iTempInt, 1))), "00") & " "
            Else
                sBinaryString = sBinaryString & temp
            End If
        Next iTempInt
        Reg_GetValue = sBinaryString
    End Select
    RegCloseKey lhKeyOpen&
End Function


Function zeichennext$(a$, ch$)
    ai% = InStr(a$, ch$)
    If ai% = 0 Then
        zeichennext$ = a$: a$ = ""
    Else
        zeichennext$ = Left$(a$, ai% - 1): a$ = Mid$(a$, ai% + Len(ch$))
    End If
End Function

Sub RegCreateKey(KeyIndex As Integer, SubKey As String, NewSubKey As String)
    Dim Security As SECURITY_ATTRIBUTES
    lhKey& = MainKey + KeyIndex

    lResult& = RegOpenKeyEx(lhKey&, SubKey, 0, KEY_CREATE_SUB_KEY, lhKeyOpen&)
    If lResult& <> ERROR_SUCCESS Then Exit Sub

    lResult& = RegCreateKeyEx(lhKeyOpen&, NewSubKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Security, lhKeyNew&, lDisposition&)
    If lResult& = ERROR_SUCCESS Then
        'If lDisposition& = REG_CREATED_NEW_KEY Then
            '   ...Schlüssel wurde angelegt
        'Else
            '   ...Schlüssel existiert bereits
        'End If
        RegCloseKey lhKeyNew&
    Else
        'Fehler...
    End If
    RegCloseKey lhKeyOpen&
End Sub

Sub Reg_SetBinary(MainKey%, Key$, sch$, wrt$)
    RegCreate MainKey%, Key$
    RegSetValue MainKey%, Key$, sch$, REG_BINARY, wrt$, Len(wrt$)
End Sub

Sub Reg_SetDWord(MainKey%, Key$, sch$, ByVal wrt&)
    RegCreate MainKey%, Key$
    w$ = ""
    For n% = 1 To Len(wrt&)
        w$ = w$ + Chr$(wrt& Mod 256)
        wrt& = Int(wrt& / 256)
    Next
    RegSetValue MainKey%, Key$, sch$, REG_DWORD, w$, Len(wrt&)
End Sub

Sub Reg_SetString(MainKey%, Key$, sch$, wrt$)
    RegCreate MainKey%, Key$
    RegSetValue MainKey%, Key$, sch$, REG_SZ, wrt$, Len(wrt$)
End Sub

Und hier ein Beispiel wie das Funktioniert:
Musst du dann entsprechend umändern
Code:
 SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
    Reg_SetString HKEY_LOCAL_MACHINE, SubKey, "Taschenrechner", "C:\Test.exe"

So ich hoffe das wars was du wolltest
 
Zuletzt bearbeitet:
Ich werde es mal testen, aber ich denke dass ist es! dankesehr. Aber wie muss ich es umändern?

Ich weiß nicht hast du dir das nochmal angesehen hab editiert

Statt Taschenrechner kannst du irgendwas rein schreiben und statt C:\test.exe halt den Programmpfard, den kannste aber auch noch rausbekommen mit ein parr Zeilen Code, wenn du dem Benutzer die möglichkeit geben willst dein Programm ab zu speichern wo er mag
 
Also ich verstehe das alle nochnicht. Der Urlange Quelltext, dafür muss ich ein Modul anlegen. Das habe ich getan. Weiter weiß ich nicht. ICh möchte, dass sich das Programm direkt beim ersten Öffnen in die Registry schreibt und sich dann beim nächsten Start automatisch öffnet. Was hat es mit dem COde in der Codebox ganz oben aufsich? Wofür ist der Code der als letztes im Post steht? Ich bitte um weitere Hilfe.
Cobfreky
 
Ja das Modul... das verstehe ich auch nicht soo richtig... Du musst halt den Code fürs einschreiben die die Reg können und wenn du willst das das beim Systemstart geht einfach so machen

Code:
Private Sub Form_Load()

SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
    Reg_SetString HKEY_LOCAL_MACHINE, SubKey, "Taschenrechner", "C:\Test.exe"

End Sub

Hast du evt Icq oder Msn dann erkläre ich dir den Code gern
 
Zurück