kann mir hier jemand meinen fehler nennen - ich möchte einen dword auslesen
Option Explicit
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Any) As Long
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long
Public Declare Function RegSetValueEx_DWORD Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) _
As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private 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
Private Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE = KEY_READ
Private Const ERROR_SUCCESS = 0&
Private Const REG_NONE = 0
Private Const reg_dword = 4
Private Const root = HKEY_LOCAL_MACHINE
Private Const key As String = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"
Private RegRoot As Long
'Proxy Starten
Public Function SetRun() As Boolean
Dim lResult As Long
Dim lKeyHandle As Long
Dim sField As String
Dim lPath As Long
sField = "ProxyEnable"
lPath = 1
lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
If lResult <> ERROR_SUCCESS Then
SetRun = False
Exit Function
End If
lResult = RegSetValueEx_DWORD(lKeyHandle, sField, 0, reg_dword, lPath, 4)
RegCloseKey lKeyHandle
SetRun = (lResult = ERROR_SUCCESS)
End Function
'Proxy Löschen
Public Function DeleteRun() As Boolean
Dim lResult As Long
Dim lKeyHandle As Long
Dim sField As String
sField = "ProxyEnable"
lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
If lResult <> ERROR_SUCCESS Then
DeleteRun = False
Exit Function
End If
lResult = RegDeleteValue(lKeyHandle, sField)
DeleteRun = (lResult = ERROR_SUCCESS)
RegCloseKey lKeyHandle
End Function
'Ist Proxy gestartet?
Public Function IsRun() As Boolean
Dim sField As String
Dim Value As Variant
Dim lResult As Long
Dim lKeyHandle As Long
Dim dwType As Long
Dim lBufferSize As Long
Dim lBuffer As Long
Dim iPos As Integer
sField = "ProxyEnable"
Value = 1
lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Key existiert nicht
lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, ByVal 0&, _
lBufferSize)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Feld existiert nicht
If dwType = reg_dword Then ' nullterminierter String
lBuffer = Space$(lBufferSize + 1)
lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, ByVal lBuffer, _
lBufferSize)
' lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, ByVal sBuffer,
' lBufferSize)
' lResult = RegSetValueEx_DWORD(lKeyHandle, sField, 0, reg_dword, lPath, 4)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Fehler beim auslesen
' des Feldes
'bis zum Nullbyte auslesen
iPos = InStr(lBuffer, Chr$(0))
If iPos Then Value = Left(lBuffer, iPos - 1)
End If
If lResult = ERROR_SUCCESS Then RegCloseKey lKeyHandle
IsRun = True
End Function |