CodeItBetter Programming Another VB Programming Blog

'System & API - How to Enable/Disable Task Manager
'Disables/Enables Task Manager (Ctl-Alt-Del) on Windows NT/XP Systems
'Registry section definitions
Public Const HKEY_CURRENT_USER = &H80000001
' Registry API functions
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
 
Public Enum InTypes
    ValString = 1
    ValDWord = 4
End Enum
 
Public Sub Main()
    'DisableTaskMgr    ' SUB to disable Task manager
    EnableTaskMgr   ' SUB to enable Task manager
End Sub
 
'Routine to Disable TaskManager
Public Sub DisableTaskMgr()
    On Error GoTo BYE
    WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", _
        "DisableTaskMgr", ValDWord, "1"
BYE:
End Sub
 
'Routine to Enable TaskManager
Public Sub EnableTaskMgr()
    On Error GoTo BYE
    WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", _
        "DisableTaskMgr", ValDWord, "0"
BYE:
End Sub
 
'Subroutine called by routines above
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
        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