Source Code for Registry Control

SOURCE CODE FOR REGISTRY CONTROL 1.0

The following has been the source code used for the development of this software, Registry Control 1.0. In case of any suggestions and improvements you can mail me to [email protected] or [email protected]

Option Explicit
'Security Mask constants
Private Const READ_CONTROL = &H20000
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
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 = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE _
Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' Possible registry data types
Public Enum InTypes
ValNull = 0
ValString = 1
ValXString = 2
ValBinary = 3
ValDword = 4
ValLink = 6
ValMultiString = 7
ValResList = 8
End Enum
' Registry value type definitions
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_RESOURCE_LIST As Long = 8
' Registry section definitions
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
' Codes returned by Reg API calls
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
' Registry API functions used in this module (there are more of them)
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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 RegQueryValueEx Lib "advapi32.dll" 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
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName 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

' This routine allows you to get values from anywhere in the Registry, it currently
' only handles string, double word and binary values. Binary values are returned as
' hex strings.
'
' Example
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
Dim TStr2 As String
Dim TStr1 As String
Dim i As Integer
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
If lDataTypeValue = REG_DWORD Then
td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
sValue = Format$(td, "000")
End If
If lDataTypeValue = REG_BINARY Then
' Return a binary field as a hex string (2 chars per byte)
TStr2 = ""
For i = 1 To lValueLength
TStr1 = Hex(Asc(Mid(sValue, i, 1)))
If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
TStr2 = TStr2 + TStr1
Next
sValue = TStr2
Else
sValue = Left$(sValue, lValueLength - 1)
End If
Else
sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistry = sValue
End Function

' This routine allows you to write values into the entire Registry, it currently
' only handles string and double word values.
'
' Example
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValString, "NewValueHere"
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValDWord, "31"
'
Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes, ByVal Value As Variant)
Dim lResult As Long
Dim lKeyValue As Long
Dim InLen As Long
Dim lNewVal As Long
Dim sNewVal As String
On Error Resume Next
lResult = RegCreateKey(Group, Section, lKeyValue)
If ValType = ValDword Then
lNewVal = CLng(Value)
InLen = 4
lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
Else
' Fixes empty string bug
If ValType = ValString Then Value = Value + Chr(0)
sNewVal = Value
InLen = Len(sNewVal)
lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
End If
lResult = RegFlushKey(lKeyValue)
lResult = RegCloseKey(lKeyValue)
End Sub

' This routine enumerates the subkeys under any given key
' Call repeatedly until "Not Found" is returned - store values in array or something
'
' Example - this example just adds all the subkeys to a string - you will probably want to
' save then into an array or something.
'
' Dim Res As String
' Dim i As Long
' Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
' Do Until Res = "Not Found"
' Text1.Text = Text1.Text & " " & Res
' i = i + 1
' Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
' Loop

Public Function ReadRegistryGetSubkey(ByVal Group As Long, ByVal Section As String, Idx As Long) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegEnumKey(lKeyValue, Idx, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
sValue = Left$(sValue, InStr(sValue, Chr(0)) - 1)
Else
sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistryGetSubkey = sValue
End Function

' This routine allows you to get all the values from anywhere in the Registry under any
' given subkey, it currently only returns string and double word values.
'
' Example - returns list of names/values to multiline text box
' Dim Res As Variant
' Dim i As Long
' Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Do Until Res(2) = "Not Found"
' Text1.Text = Text1.Text & Chr(13) & Chr(10) & Res(1) & " " & Res(2)
' i = i + 1
' Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Loop
'
Public Function ReadRegistryGetAll(ByVal Group As Long, ByVal Section As String, Idx As Long) As Variant
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long
Dim lValueLength As Long, lValueNameLength As Long
Dim sValueName As String, sValue As String
Dim td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
sValueName = Space$(2048)
lValueLength = Len(sValue)
lValueNameLength = Len(sValueName)
lResult = RegEnumValue(lKeyValue, Idx, sValueName, lValueNameLength, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
If lDataTypeValue = REG_DWORD Then
td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
sValue = Format$(td, "000")
End If
sValue = Left$(sValue, lValueLength - 1)
sValueName = Left$(sValueName, lValueNameLength)
Else
sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
' Return the datatype, value name and value as an array
ReadRegistryGetAll = Array(lDataTypeValue, sValueName, sValue)
End Function

' This routine deletes a specified key (and all its subkeys and values if on Win95) from the registry.
' Be very careful using this function.
'
' Example
' DeleteSubkey HKEY_CURRENT_USER, "Software\My Name\My App"
'
Public Function DeleteSubkey(ByVal Group As Long, ByVal Section As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKeyEx(Group, vbNullChar, 0&, KEY_ALL_ACCESS, lKeyValue)
lResult = RegDeleteKey(lKeyValue, Section)
lResult = RegCloseKey(lKeyValue)
End Function

' This routine deletes a specified value from below a specified subkey.
' Be very careful using this function.
'
' Example
' DeleteValue HKEY_CURRENT_USER, "Software\My Name\My App", "NewSubKey"
'
Public Function DeleteValue(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
lResult = RegDeleteValue(lKeyValue, Key)
lResult = RegCloseKey(lKeyValue)
End Function
Private Sub check_Click()
Dim password As String
Dim state As Integer
Dim checkpassword As String
Dim setpassword As String
Dim newpassword As String
Dim check As Integer
check = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Mic", "state")
If check = 0 Then
s1.Visible = False
GoTo newpassword
Else
GoTo oldpassword
End If
newpassword:
If n1.Text = r1.Text Then
password = n1.Text
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "encrypted", ValString, password
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "state", ValDword, "1"
Else
MsgBox ("Your passwords do not match!Try again!")
n1.Text = ""
r1.Text = ""
End If
oldpassword:
checkpassword = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Mic", "Encrypted")
If s1.Text = checkpassword Then
GoTo access
Else
MsgBox ("You have entered a wrong old password")
s1.Text = ""
GoTo sorry
End If
access:
If n1.Text = r1.Text Then
setpassword = r1.Text
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "encrypted", ValString, setpassword
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "state", ValDword, "1"
MsgBox ("You Have Successfully Changed Your New Password!")
Else
MsgBox ("The new passwords do not match!Try again")
n1.Text = ""
r1.Text = ""
End If
sorry:
Unload c
End Sub
Private Sub Command1_Click()
Check3.Visible = False
Check4.Visible = False
Check2.Visible = False
Check1.Visible = False
Check5.Visible = False
Check6.Visible = False
Check7.Visible = False
Check8.Visible = False
Check11.Visible = False
Check10.Visible = False
Check9.Visible = False
Check17.Visible = False
Check16.Visible = False
Check12.Visible = False
Check15.Visible = False
Check14.Visible = False
Check13.Visible = False
Check21.Visible = False
Check20.Visible = False
Check19.Visible = False
Check24.Visible = False
Check18.Visible = False
Check23.Visible = False
Check22.Visible = False
Check26.Visible = False
Check25.Visible = False
Check28.Visible = False
Check30.Visible = False
Check32.Visible = False
Check27.Visible = False
Check29.Visible = False
Check36.Visible = False
Check37.Visible = False
Check31.Visible = False
Check39.Visible = False
Check35.Visible = False
Check33.Visible = False
Check38.Visible = False
Check34.Visible = False
Check40.Visible = False
Frame1.Visible = False
Frame2.Visible = False
Frame3.Visible = False
Command1.Visible = False
Command2.Visible = False
Label4.Visible = True
pass.Visible = True
submit.Visible = True
exited.Visible = True
pass.PasswordChar = "*"
s1.PasswordChar = "*"
r1.PasswordChar = "*"
n1.PasswordChar = "*"
End Sub
Private Sub Command10_Click()
Dim ps1 As String
ps1 = CStr(Text29.Text)
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "encrypted", ValString, ps1
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Mic", "state", ValDword, "1"
Open "check.txt" For Output As #1
Print #1, "b"
Close #1
Check3.Visible = True
Check4.Visible = True
Check2.Visible = True
Check1.Visible = True
Check5.Visible = True
Check6.Visible = True
Check7.Visible = True
Check8.Visible = True
Check11.Visible = True
Check10.Visible = True
Check9.Visible = True
Check17.Visible = True
Check16.Visible = True
Check12.Visible = True
Check15.Visible = True
Check14.Visible = True
Check13.Visible = True
Check21.Visible = True
Check20.Visible = True
Check19.Visible = True
Check24.Visible = True
Check18.Visible = True
Check23.Visible = True
Check22.Visible = True
Check26.Visible = True
Check25.Visible = True
Check28.Visible = True
Check30.Visible = True
Check32.Visible = True
Check27.Visible = True
Check29.Visible = True
Check36.Visible = True
Check37.Visible = True
Check31.Visible = True
Check39.Visible = True
Check35.Visible = True
Check33.Visible = True
Check38.Visible = True
Check34.Visible = True
Check40.Visible = True
Frame1.Visible = True
Frame2.Visible = True
Frame3.Visible = True
Command1.Visible = True
Command2.Visible = True
Command10.Visible = False
Label5.Visible = False
Text29.Visible = False
End Sub
Private Sub Command2_Click()
Check3.Visible = False
Check4.Visible = False
Check2.Visible = False
Check1.Visible = False
Check5.Visible = False
Check6.Visible = False
Check7.Visible = False
Check8.Visible = False
Check11.Visible = False
Check10.Visible = False
Check9.Visible = False
Check17.Visible = False
Check16.Visible = False
Check12.Visible = False
Check15.Visible = False
Check14.Visible = False
Check13.Visible = False
Check21.Visible = False
Check20.Visible = False
Check19.Visible = False
Check24.Visible = False
Check18.Visible = False
Check23.Visible = False
Check22.Visible = False
Check26.Visible = False
Check25.Visible = False
Check28.Visible = False
Check30.Visible = False
Check32.Visible = False
Check27.Visible = False
Check29.Visible = False
Check36.Visible = False
Check37.Visible = False
Check31.Visible = False
Check39.Visible = False
Check35.Visible = False
Check33.Visible = False
Check38.Visible = False
Check34.Visible = False
Check40.Visible = False
Frame1.Visible = False
Frame2.Visible = False
Frame3.Visible = False
Command1.Visible = False
Command2.Visible = False
pass.Visible = True
submit.Visible = False
pass.PasswordChar = "*"
s1.PasswordChar = "*"
r1.PasswordChar = "*"
n1.PasswordChar = "*"
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
s1.Visible = True
r1.Visible = True
n1.Visible = True
check.Visible = True
End Sub
Private Sub Command3_Click()
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Mic", "encrypted", ValString, ""
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Mic", "state", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disableregisterytools", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodesktop", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noclose", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofind", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nonethood", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoRecentDocsMenu", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "norun", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSetFolders", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOptions", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noconfigpage", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nopwdpage", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDispAppearancePage", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDispAppearancePage", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoVirtMemPage", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEntireNetwork", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nointerneticon", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disabled", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoActiveDesktop", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEditMenu", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nohelp", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoLogOff", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nosmmydocs", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFonts", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodrives", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofilemenu", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "notaskbar", ValDword, "0"
WriteRegistry HKEY_LOCAL_MACHINE, "Software\CLASSES\lnkfile", "Editflags", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "Hidden", ValDword, "0"
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDriveTypeAutoRun ", ValDword, "0"
Open "check.txt" For Output As #1
Print #1, "b"
Close #1
Command3.Visible = False
Check3.Visible = False
Check4.Visible = False
Check2.Visible = False
Check1.Visible = False
Check5.Visible = False
Check6.Visible = False
Check7.Visible = False
Check8.Visible = False
Check11.Visible = False
Check10.Visible = False
Check9.Visible = False
Check17.Visible = False
Check16.Visible = False
Check12.Visible = False
Check15.Visible = False
Check14.Visible = False
Check13.Visible = False
Check21.Visible = False
Check20.Visible = False
Check19.Visible = False
Check24.Visible = False
Check18.Visible = False
Check23.Visible = False
Check22.Visible = False
Check26.Visible = False
Check25.Visible = False
Check28.Visible = False
Check30.Visible = False
Check32.Visible = False
Check27.Visible = False
Check29.Visible = False
Check36.Visible = False
Check37.Visible = False
Check31.Visible = False
Check39.Visible = False
Check35.Visible = False
Check33.Visible = False
Check38.Visible = False
Check34.Visible = False
Check40.Visible = False
Frame1.Visible = False
Frame2.Visible = False
Frame3.Visible = False
Command1.Visible = False
Command2.Visible = False
Command10.Visible = True
Text29.PasswordChar = "*"
Text30.PasswordChar = "*"
Text29.Visible = True
Label5.Visible = True
End Sub
Private Sub exited_Click()
Unload c
End Sub
Sub Form_Load()
Dim registery As Integer
Dim desktop As Integer
Dim shutdown As Integer
Dim find As Integer
Dim networkicon As Integer
Dim recent As Integer
Dim run As Integer
Dim cpl As Integer
Dim folder As Integer
Dim hware As Integer
Dim pwd As Integer
Dim disp As Integer
Dim virtual As Integer
Dim network As Integer
Dim net As Integer
Dim dos As Integer
Dim active As Integer
Dim a As String
Dim menu As Integer
Dim help As Integer
Dim logoff As Integer
Dim my As Integer
Dim font As Integer
Dim paval As String
Dim drive As Integer
Dim file As Integer
Dim tbar As Integer
Open "check.txt" For Input As #1
Line Input #1, a
Close #1
If a <> "a" Then
Command3.Visible = False
End If
Text1.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disableregisterytools")
registery = CInt(Text1.Text)
If registery = 1 Then
Check3.Value = 1
End If
Text2.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodesktop")
desktop = CInt(Text2.Text)
If desktop = 1 Then
Check4.Value = 1
End If
Text3.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Noclose")
shutdown = CInt(Text3.Text)
If shutdown = 1 Then
Check2.Value = 1
End If
Text4.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofind")
find = CInt(Text4.Text)
If find = 1 Then
Check1.Value = 1
End If
Text5.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nonethood")
networkicon = CInt(Text5.Text)
If networkicon = 1 Then
Check5.Value = 1
End If
Text6.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Norecentdocsmenu")
recent = CInt(Text6.Text)
If recent = 1 Then
Check6.Value = 1
End If
Text7.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "norun")
run = CInt(Text7.Text)
If run = 1 Then
Check13.Value = 1
End If
Text8.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSetFolders")
cpl = CInt(Text8.Text)
If cpl = 1 Then
Check8.Value = 1
End If
Text9.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOptions")
folder = CInt(Text9.Text)
If folder = 1 Then
Check11.Value = 1
End If
Text10.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noconfigpage")
hware = CInt(Text10.Text)
If hware = 1 Then
Check10.Value = 1
End If
Text11.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nopwdpage")
pwd = CInt(Text11.Text)
If pwd = 1 Then
Check9.Value = 1
End If
Text12.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDispAppearancePage")
disp = CInt(Text12.Text)
If disp = 1 Then
Check17.Value = 1
End If
Text13.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoVirtMemPage")
virtual = CInt(Text13.Text)
If virtual = 1 Then
Check16.Value = 1
End If
Text14.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEntireNetwork")
network = CInt(Text14.Text)
If network = 1 Then
Check12.Value = 1
End If
Text15.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nointerneticon")
net = CInt(Text15.Text)
If net = 1 Then
Check15.Value = 1
End If
Text16.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disabled")
dos = CInt(Text16.Text)
If dos = 1 Then
Check14.Value = 1
End If
Text17.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoActiveDesktop")
active = CInt(Text17.Text)
If active = 1 Then
Check13.Value = 1
End If
Text18.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEditMenu")
menu = CInt(Text18.Text)
If menu = 1 Then
Check21.Value = 1
End If
Text19.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nohelp")
help = CInt(Text19.Text)
If help = 1 Then
Check20.Value = 1
End If
Text20.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoLogOff")
logoff = CInt(Text20.Text)
If logoff = 1 Then
Check19.Value = 1
End If
Text21.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nosmmydocs")
my = CInt(Text21.Text)
If my = 1 Then
Check24.Value = 1
End If
Text22.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nofonts")
font = CInt(Text22.Text)
If font = 1 Then
Check18.Value = 1
End If
Text23.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodrives")
drive = CInt(Text23.Text)
If drive = 1 Then
Check23.Value = 1
End If
Text24.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nofilemenu")
file = CInt(Text24.Text)
If file = 1 Then
Check22.Value = 1
End If
Text25.Text = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "notaskbar")
tbar = CInt(Text25.Text)
If tbar = 1 Then
Check26.Value = 1
End If
End Sub

Private Sub submit_Click()
Dim banner As String
Dim check As String
Dim serial As String
Dim startpage As String
Dim title As String
Dim message As String
Dim name As String
check = pass.Text
If check = ReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Mic", "Encrypted") Then
GoTo accessgranted
Else
GoTo failed
End If
accessgranted:
'registery
If Check3.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disableregisterytools", ValDword, "1"
ElseIf Check3.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disableregisterytools", ValDword, "0"
End If
'desktop
If Check4.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodesktop", ValDword, "1"
ElseIf Check4.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodesktop", ValDword, "0"
End If
'shutdown
If Check2.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noclose", ValDword, "1"
ElseIf Check2.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noclose", ValDword, "0"
End If
'find
If Check1.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofind", ValDword, "1"
ElseIf Check1.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofind", ValDword, "0"
End If
'network icon
If Check5.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nonethood", ValDword, "1"
ElseIf Check5.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nonethood", ValDword, "0"
End If
'No recent Docs Menu
If Check6.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoRecentDocsMenu", ValDword, "1"
ElseIf Check6.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoRecentDocsMenu", ValDword, "0"
End If
'No run
If Check7.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "norun", ValDword, "1"
ElseIf Check7.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "norun", ValDword, "0"
End If
'control panel
If Check11.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSetFolders", ValDword, "1"
ElseIf Check11.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSetFolders", ValDword, "0"
End If
'No folder
If Check8.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOptions", ValDword, "1"
ElseIf Check8.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOptions", ValDword, "0"
End If
'No hardware
If Check10.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noconfigpage", ValDword, "1"
ElseIf Check10.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "noconfigpage", ValDword, "0"
End If
'No passward
If Check9.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nopwdpage", ValDword, "1"
ElseIf Check9.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nopwdpage", ValDword, "0"
End If
'display
If Check17.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDispAppearancePage", ValDword, "1"
ElseIf Check17.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDispAppearancePage", ValDword, "0"
End If
'No virtualmemory
If Check16.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoVirtMemPage", ValDword, "1"
ElseIf Check16.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoVirtMemPage", ValDword, "0"
End If
'No network
If Check12.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEntireNetwork", ValDword, "1"
ElseIf Check12.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEntireNetwork", ValDword, "0"
End If
'No internet
If Check15.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nointerneticon", ValDword, "1"
ElseIf Check15.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nointerneticon", ValDword, "0"
End If
'No dosprompt
If Check14.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disabled", ValDword, "1"
ElseIf Check14.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "disabled", ValDword, "0"
End If
'No Active Desktop
If Check13.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoActiveDesktop", ValDword, "1"
ElseIf Check13.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoActiveDesktop", ValDword, "0"
End If
'No stmenu
If Check21.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEditMenu", ValDword, "1"
ElseIf Check21.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoEditMenu", ValDword, "0"
End If
'No help
If Check20.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nohelp", ValDword, "1"
ElseIf Check20.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nohelp", ValDword, "0"
End If
'No logoff
If Check19.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoLogOff", ValDword, "1"
ElseIf Check19.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoLogOff", ValDword, "0"
End If
'No mydocs
If Check24.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nosmmydocs", ValDword, "1"
ElseIf Check24.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nosmmydocs", ValDword, "0"
End If
'No font
If Check18.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFonts", ValDword, "1"
ElseIf Check18.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFonts", ValDword, "0"
End If

'No drive
If Check23.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodrives", ValDword, "1"
ElseIf Check23.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "nodrives", ValDword, "0"
End If
'No filemenu
If Check22.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFilemenu", ValDword, "1"
ElseIf Check22.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "Nofilemenu", ValDword, "0"
End If
'No tbar
If Check26.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "notaskbar", ValDword, "1"
ElseIf Check26.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "notaskbar", ValDword, "0"
End If
'typed Urls
If Check25.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\TypedURLs"
End If
'Mplayer
If Check28.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Microsoft\MediaPlayer\Player\RecentURLList"
End If
'My docs
If Check30.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RecentDocs"
End If
'Find List
If Check32.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Doc Find Spec MRU"
End If
'Winzip recent filelist
If Check35.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Nico Mak Computing\WinZip\filemenu"
End If
'Add fancy Toolbar
If Check27.Value = 1 Then
banner = InputBox("Please Enter The Bitmap File You Want to Choose.Eg:c:\one.bmp")
WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Internet Explorer\Toolbar", "BackBitmap", ValString, banner
End If
'Banner
If Check36.Value = 1 Then
title = InputBox("Enter The Title Of The Banner")
message = InputBox("Enter Message The Banner")
WriteRegistry HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\WinLogon", "LegalNoticeCaption", ValString, title
WriteRegistry HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\WinLogon", "LegalNoticeText", ValString, message
End If
'shortcut Marks
If Check29.Value = 1 Then
DeleteValue HKEY_LOCAL_MACHINE, "Software\CLASSES\lnkfile", "Isshortcut"
WriteRegistry HKEY_LOCAL_MACHINE, "Software\CLASSES\lnkfile", "Editflags", ValDword, "0"
End If
'Hide folders
If Check37.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "Hidden", ValDword, "0"
ElseIf Check31.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "Hidden", ValDword, "1"
End If
'Autorun cd's
If Check31.Value = 1 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDriveTypeAutoRun ", ValDword, "0"
ElseIf Check31.Value = 0 Then
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDriveTypeAutoRun ", ValDword, "1"
End If
'Clear run commands
If Check38.Value = 1 Then
DeleteSubkey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RunMRU"
End If
'Recover 98 Serial Key
If Check33.Value = 1 Then
serial = ReadRegistry(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "Productkey")
MsgBox (serial)
End If
'Change Windows User Name
If Check39.Value = 1 Then
name = InputBox("Enter The New Windows User Name:")
WriteRegistry HKEY_LOCAL_MACHINE, "Network\Logon", "username", ValString, name
End If
'Explorer
If Check34.Value = 1 Then
startpage = InputBox("Enter the iExplorer Startpage")
WriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page", ValString, startpage
End If
'Clear Startup
If Check40.Value = 1 Then
DeleteSubkey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run"
End If
MsgBox ("Your Settings Have Been Saved!Thank You!")
GoTo finish
failed:
MsgBox ("Your Password did not Match!Try Again")
pass.Text = ""
finish:
Load c
End Sub

Note:

The users can modify and use this coding for personal and educational use and should not be used for building commercial software.

Hosted by www.Geocities.ws