Option Explicit
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 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
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 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 Any, ByVal cbData As Long) As Long
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Private Sub Command1_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
If Check1.Value = 1 Then
Check1.Tag = 1
Else
Check1.Tag = 0
End If

If Check2.Value = 1 Then
Check2.Tag = 2
Else
Check2.Tag = 0
End If
If Check3.Value = 1 Then
Check3.Tag = 4
Else
Check3.Tag = 0
End If

If Check4.Value = 1 Then
Check4.Tag = 8
Else
Check4.Tag = 0
End If
If Check5.Value = 1 Then
Check5.Tag = 16
Else
Check5.Tag = 0
End If

If Check6.Value = 1 Then
Check6.Tag = 32
Else
Check6.Tag = 0
End If
If Check7.Value = 1 Then
Check7.Tag = 64
Else
Check7.Tag = 0
End If

If Check8.Value = 1 Then
Check8.Tag = 128
Else
Check8.Tag = 0
End If
If Check9.Value = 1 Then
Check9.Tag = 256
Else
Check9.Tag = 0
End If

If Check10.Value = 1 Then
Check10.Tag = 512
Else
Check10.Tag = 0
End If
If Check11.Value = 1 Then
Check11.Tag = 1024
Else
Check11.Tag = 0
End If

If Check12.Value = 1 Then
Check12.Tag = 2048
Else
Check12.Tag = 0
End If
If Check13.Value = 1 Then
Check13.Tag = 4096
Else
Check13.Tag = 0
End If

If Check14.Value = 1 Then
Check14.Tag = 8192
Else
Check14.Tag = 0
End If
If Check15.Value = 1 Then
Check15.Tag = 16384
Else
Check15.Tag = 0
End If

If Check16.Value = 1 Then
Check16.Tag = 32768
Else
Check16.Tag = 0
End If
If Check17.Value = 1 Then
Check17.Tag = 65536
Else
Check17.Tag = 0
End If

If Check18.Value = 1 Then
Check18.Tag = 131072
Else
Check18.Tag = 0
End If
If Check19.Value = 1 Then
Check19.Tag = 262144
Else
Check19.Tag = 0
End If '

If Check20.Value = 1 Then
Check20.Tag = 524288
Else
Check20.Tag = 0
End If
If Check21.Value = 1 Then
Check21.Tag = 1048576
Else
Check21.Tag = 0
End If

If Check22.Value = 1 Then
Check22.Tag = 2097152
Else
Check22.Tag = 0
End If
If Check23.Value = 1 Then
Check23.Tag = 4194304
Else
Check23.Tag = 0
End If

If Check24.Value = 1 Then
Check24.Tag = 8388608
Else
Check24.Tag = 0
End If
If Check25.Value = 1 Then
Check25.Tag = 16777216
Else
Check25.Tag = 0
End If

If Check26.Value = 1 Then
Check26.Tag = 33554432
Else
Check26.Tag = 0
End If

a1 = CLng(Check1.Tag) + CLng(Check2.Tag) + CLng(Check3.Tag) _
+ CLng(Check4.Tag) + CLng(Check5.Tag) + CLng(Check6.Tag) + _
CLng(Check7.Tag) + CLng(Check8.Tag) + CLng(Check9.Tag) + _
CLng(Check10.Tag) + CLng(Check11.Tag) + CLng(Check12.Tag) _
+ CLng(Check13.Tag) + CLng(Check14.Tag) + CLng(Check15.Tag) + _
CLng(Check16.Tag) + CLng(Check17.Tag) + CLng(Check18.Tag) _
+ CLng(Check19.Tag) + CLng(Check20.Tag) + CLng(Check21.Tag) _
+ CLng(Check22.Tag) + CLng(Check23.Tag) + CLng(Check24.Tag) _
+ CLng(Check25.Tag) + CLng(Check26.Tag)
If a1 = 0 Then
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
Else
If a1 <> 0 Then
regkey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
retvalue = RegCreateKey(HKEY_CURRENT_USER, regkey, KeyID)
subKey = "NoDrives"
keyvalue = a1
retvalue = RegSetValueEx(KeyID, subKey, 0&, 4, keyvalue, 4)
End If
End If
End Sub




Private Sub Command2_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
End Sub

Private Sub Form_Load()

End Sub