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_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
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 root = HKEY_CURRENT_USER
Private Const key As String = _
  "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"
 
Public Function SetRun() As Boolean
  Dim lResult As Long
  Dim lKeyHandle As Long
  Dim sField As String
  Dim sPath As String
 
  sField = "ProxyEnable"
  sPath = 1
 
  lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
  If lResult <> ERROR_SUCCESS Then
    SetRun = False
    Exit Function
  End If
 
  lResult = RegSetValueEx_String(lKeyHandle, sField, 0, reg_dword, sPath, Len( _
    sPath) + 1)
  RegCloseKey lKeyHandle
  SetRun = (lResult = ERROR_SUCCESS)
End Function
 
Public Function DeleteRun() As Boolean
  Dim lResult As Long
  Dim lKeyHandle As Long
  Dim sField As String
  Dim sPath As String
 
  sField = "ProxyEnable"
  sPath = 0
 
  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
 
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 sBuffer As String
  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
    sBuffer = Space$(lBufferSize + 1)
    lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, ByVal sBuffer, _
      lBufferSize)
    IsRun = (lResult = ERROR_SUCCESS)
    If lResult <> ERROR_SUCCESS Then Exit Function ' Fehler beim auslesen 
    ' des Feldes
    'bis zum Nullbyte auslesen
    iPos = InStr(sBuffer, Chr$(0))
    If iPos Then Value = Left(sBuffer, iPos - 1)
  End If
 
  If lResult = ERROR_SUCCESS Then RegCloseKey lKeyHandle
  IsRun = True
End Function