Microsoft Excel

Herbers Excel/VBA-Archiv

Fehlermeldung "ByRef"

Betrifft: Fehlermeldung "ByRef" von: Torsten
Geschrieben am: 12.09.2004 11:15:07

Hallo!
Mein Problem bezieht sich nicht direkt auf VBA, sondern direkt auf VB 6.
Ich erstelle gerade ein Tool, womit ich Registry-Änderungen einfacher vornehmen kann.
Das "Grundgerüst" (siehe ZIP-Datei: https://www.herber.de/bbs/user/10800.zip ) funktioniert eigentlich prima. Aber nur solange ich es auf den Schlüssel "HKEY_LOCAL_USER" anwende. Sobald ich es bei einem anderen Schlüssel probiere bekomme ich die Fehlermeldung "Fehler beim Kompilieren: Argumenttyp ByRef unverträglich".



Ich hab schon alles mögliche probiert, ohne Erfolg.

Vielleicht hat jemand auch schon das Problem gehabt?

Vielen Dank schon mal !!!

Torsten

  


Betrifft: AW: Fehlermeldung "ByRef" von: Ulf
Geschrieben am: 12.09.2004 13:22:36

Auf beiden Seiten ist der identische Datentyp erforderlich.

Ulf


  


Betrifft: AW: Fehlermeldung "ByRef" von: Torsten
Geschrieben am: 12.09.2004 14:13:02

Hallo Ulf!
Ja, aber ich hab keine Ahnung wie ich das Problem behebe.
(Bin in VB halt nicht so fit.)

Vielleicht siehst du ja auf Anhieb die Stelle?

Hier mal der Code.

****************************************************************************************

Erst mal die Module:

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

'wird die Ordner-Erstellung benötigt:
Public oFSO As New FileSystemObject

'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$, 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


*****************************************************************************************
Nun der relevante Code des Command-Buttons:

Private
Sub Ausführen_Click()

If Tun(1).Value = 1 Then
SubKey = "AAAAA"
Reg_SetDWord HKEY_CURRENT_MACHINE, SubKey, "NeuDWord", 0

Else
End If

*****************************************************************************************

Danke schon mal!!!

Torsten



  


Betrifft: AW: Fehlermeldung "ByRef" von: Ulf
Geschrieben am: 12.09.2004 14:47:21

Reg_SetDWord HKEY_CURRENT_MACHINE, SubKey, "NeuDWord", 0

HKEY_CURRENT_MACHINE ist nirgends deklariert und somit Variant!

Die Konstanten sind alle nicht typisiert.
Auf weitere Fehler nicht getestet.

Ulf


  


Betrifft: AW: Fehlermeldung "ByRef" von: Torsten
Geschrieben am: 13.09.2004 14:33:51

Kannst du mir an einem Beispiel mal zeigen, wie ich das mache?

Torsten


  


Betrifft: AW: Fehlermeldung "ByRef" von: Ulf
Geschrieben am: 15.09.2004 22:35:48

Public Const HKEY_CLASSES_ROOT as long = 0

Ulf


  


Betrifft: AW: Fehlermeldung "ByRef" von: Torsten
Geschrieben am: 16.09.2004 12:20:21

Tausend Dank Ulf !!! :-)

Torsten


  


Betrifft: "ByRef" + doch was mit Berechtigungen? von: Torsten
Geschrieben am: 16.09.2004 14:43:27

Nee, geht aber immer noch nicht.
Seltsamerweise geht`s ja prima bei HKEY_CURRENT_USER (auch ohne "As Long").
Aber bei keinem anderen Schlüssel.
Hat das vielleicht doch irgendwie mit Zugriffsrechten zu tun (obwohl ich als lokaler Admin angemeldet bin)?

'Hauptschlüssel
Const MainKey = &H80000000
Public Const HKEY_CLASSES_ROOT As Long = 0
Public Const HKEY_CURRENT_USER As Long = 1
Public Const HKEY_LOCAL_MACHINE As Long = 2
Public Const HKEY_USERS As Long = 3
Public Const HKEY_PERFORMANCE_DATA As Long = 4 '(nur NT)
Public Const HKEY_CURRENT_CONFIG As Long = 5
Public Const HKEY_DYN_DATA As Long = 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

Torsten


 

Beiträge aus den Excel-Beispielen zum Thema "Fehlermeldung "ByRef""