vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

VB & Windows API
API in einen REG_DWORD 0 oder 1 eintragen 
Autor: LP
Datum: 20.05.05 14:33

hallo
ich möchte in eine reg_dword den wert 1 übergeben
nun habe ich folgendes programm geschrieben
...
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
...

an der stelle (fett) muss allerdings ein fehler sein, weil der wert den cih übergebe nie 1 ist - hat jemand vielleicht eine idee?
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
API in einen REG_DWORD 0 oder 1 eintragen2.824LP20.05.05 14:33
Re: API in einen REG_DWORD 0 oder 1 eintragen2.275ModeratorMartoeng20.05.05 14:42
Re: API in einen REG_DWORD 0 oder 1 eintragen1.376LP20.05.05 14:46
Re: API in einen REG_DWORD 0 oder 1 eintragen914ModeratorMartoeng20.05.05 16:06
Re: API in einen REG_DWORD 0 oder 1 eintragen762LP20.05.05 16:30
keine idee?760LP20.05.05 15:35
Re: API in einen REG_DWORD 0 oder 1 eintragen1.150[email protected]21.05.05 13:33
Re: API in einen REG_DWORD 0 oder 1 eintragen1.101LP30.05.05 08:52
Re: API in einen REG_DWORD 0 oder 1 eintragen870LP30.05.05 11:07

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2022 [email protected] Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel