In VB6 "Strg+Alt+Entf" sperren?

Wie gesagt das ist net so leicht!

Hier der Code:
Option Explicit

Private 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

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private 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

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal _
lpSubKey As String, ByVal Reserved As Long, ByVal _
lpClass As String, ByVal dwOptions As Long, ByVal _
samDesired As Long, ByVal lpSecurityAttributes As Any, _
phkResult As Long, lpdwDisposition As Long) As Long

Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long

Private Declare Function RegSetValueEx 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

Private Declare Function RegSetValueEx_Str 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

Private Declare Function RegDeleteKey Lib "advapi32.dll"Alias _
"RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll"Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName _
As String) As Long


Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS _
Or KEY_NOTIFY
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
Const ERROR_SUCCESS = 0&

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_OPTION_NON_VOLATILE = &H0

Private RegRoot&

Private Sub Command8_Click()
Call Shell("regedit.exe", vbNormalFocus)
End Sub

Private Sub Form_Load()
'Voreinstellungen eintragen
Text1.Text = "Test-Ordner"
Text2.Text = "Test-Ordner"

Text3.Text = "Test-Ordner"
Text4.Text = "Wert-Long"
Text5.Text = "12345"

Text6.Text = "Test-Ordner"
Text7.Text = "Wert-String"
Text8.Text = "Hallo"

Text9.Text = "Test-Ordner"
Text10.Text = "Wert-Long"
Text11.Text = "Test-Ordner"
Text12.Text = "Wert-String"

Text13.Text = "Test-Ordner"
Text14.Text = "Wert-Long"
Text15.Text = "Test-Ordner"
Text16.Text = "Wert-String"

Text17.Text = "Test-Ordner"

List1.AddItem "HKEY_CLASSES_ROOT"
List1.ItemData(0) = HKEY_CLASSES_ROOT
List1.AddItem "HKEY_CURRENT_USER"
List1.ItemData(1) = HKEY_CURRENT_USER
List1.AddItem "HKEY_LOCAL_MACHINE"
List1.ItemData(2) = HKEY_LOCAL_MACHINE
List1.AddItem "HKEY_USERS"
List1.ItemData(3) = HKEY_USERS
List1.AddItem "HKEY_PERFORMANCE_DATA"
List1.ItemData(4) = HKEY_PERFORMANCE_DATA
List1.AddItem "HKEY_CURRENT_CONFIG"
List1.ItemData(5) = HKEY_CURRENT_CONFIG
List1.AddItem "HKEY_DYN_DATA"
List1.ItemData(6) = HKEY_DYN_DATA

List1.ListIndex = 2
End Sub

Private Sub List1_Click()
'Bei Klick Hauptverzeichnis wechseln
Frame6.Caption = List1.List(List1.ListIndex)
RegRoot = List1.ItemData(List1.ListIndex)
End Sub

Private Sub Command1_Click()
Dim Result&
'Schlüssel erstellen
Result = RegKeyCreate(RegRoot, Text1.Text)

Select Case Result
Case 0: Label5.Caption = "Fehler beim Erstellen"
Case 1: Label5.Caption = "Ok, Pfad neu erstellt"
Case 2: Label5.Caption = "Ok, Pfad existierte schon"
End Select
End Sub

Private Sub Command2_Click()
Dim Result&
'Testen ob Schlüssel existiert
Result = RegKeyExist(RegRoot, Text2.Text)

If Result = 0 Then
Label6.Caption = "vorhanden"
Else
Label6.Caption = "nicht vorhanden"
End If
End Sub

Private Sub Command3_Click()
Dim Result&, LngInt&
'Longwert ein ein Feld schreiben
LngInt = CLng(Val(Text5.Text))
Result = RegValueSet(RegRoot, Text3.Text, Text4.Text, LngInt)

If Result = 0 Then
Label7.Caption = "Ok"
Else
Label7.Caption = "Fehler"
End If
End Sub
 
Private Sub Command4_Click()
Dim Result&, StrVar$
'Stringwert in ein Feld schreiben
StrVar = CStr(Text8.Text)
Result = RegValueSet(RegRoot, Text6.Text, Text7.Text, StrVar)

If Result = 0 Then
Label8.Caption = "Ok"
Else
Label8.Caption = "Fehler"
End If
End Sub

Private Sub Command5_Click()
Dim Result&, Value As Variant
'Longwert auslesen
Result = RegValueGet(RegRoot, Text9.Text, Text10.Text, Value)
If Result = 0 Then
Label9.Caption = CStr(Value)
Label10.Caption = "Ok"
Else
Label9.Caption = ""
Label10.Caption = "Fehler"
End If

'Stringwert auslesen
Result = RegValueGet(RegRoot, Text11.Text, Text12.Text, Value)
If Result = 0 Then
Label11.Caption = CStr(Value)
Label12.Caption = "Ok"
Else
Label11.Caption = ""
Label12.Caption = "Fehler"
End If
End Sub

Private Sub Command6_Click()
Dim Result&
'Feld des Longwertes löschen
Result = RegFieldDelete(RegRoot, Text13.Text, Text14.Text)
If Result = 0 Then
Label13.Caption = "Ok"
Else
Label13.Caption = "Fehler"
End If

'Feld des Srtingwertes löschen
Result = RegFieldDelete(RegRoot, Text15.Text, Text16.Text)
If Result = 0 Then
Label14.Caption = "Ok"
Else
Label14.Caption = "Fehler"
End If
End Sub

Private Sub Command7_Click()
Dim Result&
'Schlüssel löschen
Result = RegKeyDelete(RegRoot, Text17.Text)
If Result = 0 Then
Label15.Caption = "Ok"
Else
Label15.Caption = "Fehler"
End If
End Sub



Function RegKeyExist(Root&, Key$) As Long
Dim Result&, hKey&
'Prüfen ob ein Schlüssel existiert
Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)
If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey)
RegKeyExist = Result
End Function

Function RegKeyCreate(Root&, Newkey$) As Long
Dim Result&, hKey&, Back&
'Neuen Schlüssel erstellen
Result = RegCreateKeyEx(Root, Newkey, 0, vbNullString, _
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, Back)
If Result = ERROR_SUCCESS Then
Result = RegFlushKey(hKey)
If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey)
RegKeyCreate = Back
End If
End Function

Private Function RegKeyDelete(Root&, Key$) As Long
'Schlüssel erstellen
RegKeyDelete = RegDeleteKey(Root, Key)
End Function

Private Function RegFieldDelete(Root&, Key$, Field$) As Long
Dim Result&, hKey&
'Feld löschen
Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)
If Result = ERROR_SUCCESS Then
Result = RegDeleteValue(hKey, Field)
Result = RegCloseKey(hKey)
End If
RegFieldDelete = Result
End Function

Function RegValueSet(Root&, Key$, Field$, Value As Variant) As Long
Dim Result&, hKey&, s$, l&
'Wert in ein Feld der Registry schreiben
Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)
If Result = ERROR_SUCCESS Then
Select Case VarType(Value)
Case vbInteger, vbLong
l = CLng(Value)
Result = RegSetValueEx(hKey, Field, 0, REG_DWORD, l, 4)
Case vbString
s = CStr(Value)
Result = RegSetValueEx_Str(hKey, Field, 0, REG_SZ, s, _
Len(s) + 1)
End Select
Result = RegCloseKey(hKey)
End If

RegValueSet = Result
End Function

Function RegValueGet(Root&, Key$, Field$, Value As Variant) As Long
Dim Result&, hKey&, dwType&, Lng&, Buffer$, l&
'Wert aus einem Feld der Registry auslesen
Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)
If Result = ERROR_SUCCESS Then
Result = RegQueryValueEx(hKey, Field, 0&, dwType, ByVal 0&, l)
If Result = ERROR_SUCCESS Then
Select Case dwType
Case REG_SZ
Buffer = Space$(l + 1)
Result = RegQueryValueEx(hKey, Field, 0&, _
dwType, ByVal Buffer, l)
If Result = ERROR_SUCCESS Then Value = Buffer
Case REG_DWORD
Result = RegQueryValueEx(hKey, Field, 0&, dwType, Lng, l)
If Result = ERROR_SUCCESS Then Value = Lng
End Select
End If
End If

If Result = ERROR_SUCCESS Then Result = RegCloseKey(hKey)
RegValueGet = Result
End Function
 
ah, nur so wenig

thanks, aber:

1. Hoff ich mal, dass du das nicht geschrieben, sonderen von
wo anderst kopiert hast. (Ist ja echt ne Menge :eek: )

2. Leider blick ich überhaupt nicht durch. Hab die Labels und
Buttons erstellt und denn code eingefügt, aber ich blick irgendwie
auch nicht durch den code durch.

Darum->
3. Könntest du mir vielleicht bitte so ein kleines Bsp.
schicken, bei dem man einfach auf einen Button drückt,
und sich dann das gerade laufende prog in die Reg unter
RUN einträgt. Würde das gehen?

:)PLEASE:)
 
Hab im mom kein Vb drauf und programmier auch selber kaum noch mit. Aber ich hab mal son Regedit Programm geschrieben, mal sehen ob ich das finde.
 
sorry wenn ich mich einmische :) aber ich habe da ne idee. mein prog startet auch über die registry und trägt sich bei jedem start auch wieder von alleine rein, falls jemand den eintrag löschen sollte.

das script mit dem langen code da eben hab ich aber nicht benutzt, ich habs anders, aber für meine begriffe bisschen einfacher gemacht!

mein vb prog erstellt einfach mit OPEN ...for OUPUT as #1
eine datei namens tmp.reg wo dann der header + der reg-befehl zum eintragen drinsteht, also
---
REGEDIT4

<Reg-Schlüssel bla bla>
---
und dannach einfach mit
---
SHELL Environ$("WINDIR") & "\regedit.exe " & chr(34) & app.path & "\tmp.reg" & chr(34), vbHide
---
ausführen und die datei wird über den registrierungseditor eingefügt.
das chr(34) muss sein, damit bei langen dateinamen anführungszeichen gesetzt werden.

dannach nurnoch mit Kill app.path & "\tmp.reg" die datei löschen und keiner hat was gemerkt!

funzt 100% ;)

ok schöne grüsse ciao
 
da wir ja nun ein paar jahre weiter sind und es window xp inzwischen gibt, funktioniert der obig genannte befehl(alt+strg+entf sperren) nicht mehr.
gibt es inzwischen einen neuen oder verbesserten?

bei meinem alten pc hat der gut funktioniert und mein bruder konnte keinen schei.. mehr bauen, nun habe ich aber einen neuen und mein bruder kann wieder drauf zugreifen.
und da meine eltern auch noch an meinen pc für fernseh gucken(tv-karte) wollen, darf ich nicht nur ein acc haben.

könnt ihr mir helfen?

danke im vorraus.

ps: sollte die auf grund von windows nicht mehr möglich sein, so bitte auch schreiben. danke.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück