03 April, 2011

disable dan enable task manager dengan vb 6

setelah nyari2 script untuk disable task manager akhirnya ketemu juga yang pas untuk fitur tambahan aplikasi yang pengen saya buat .hhihi
script ini berfungsi untuk menonaktifkan dan mengaktifkan task manager. ok, langsung aja kita coba praktek yaa.. :)
pertama buat project baru dan masukkan 2 komponen CommandButton, ubah Caption Command1 dengan "Enable Task Manager" dan Caption Command2 dengan "Disable Task Manager".
berikut ini adalah scriptnya:

Form1.frm

Private Sub Command1_Click()
  AntiTaskManagerController True
  MsgBox "Task Manager Enabled"
End Sub

Private Sub Command2_Click()
  AntiTaskManagerController False
  MsgBox "Task Manager Disabled"
End Sub

modGlobal.bas
Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
  Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
  Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
  Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
  Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  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
  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
  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
  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
  Declare Function RegQueryValueExString 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
  Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
  Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

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

Enum RegistryLongTypes
  REG_SZ = 1
  REG_BINARY = 3
  REG_DWORD = 4
  REG_DWORD_BIG_ENDIAN = 5
  REG_DWORD_LITTLE_ENDIAN = 4
End Enum

Enum RegistryKeyAccess
  KEY_CREATE_LINK = &H20
  KEY_CREATE_SUB_KEY = &H4
  KEY_ENUMERATE_SUB_KEYS = &H8
  KEY_EVENT = &H1
  KEY_NOTIFY = &H10
  KEY_QUERY_VALUE = &H1
  KEY_SET_VALUE = &H2
  READ_CONTROL = &H20000
  STANDARD_RIGHTS_ALL = &H1F0000
  STANDARD_RIGHTS_REQUIRED = &HF0000
  SYNCHRONIZE = &H100000
  STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
  STANDARD_RIGHTS_READ = (READ_CONTROL)
  STANDARD_RIGHTS_WRITE = (READ_CONTROL)

  KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL + KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
  KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
  KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
End Enum

Enum RegistryErrorCodes
  ERROR_ACCESS_DENIED = 5&
  ERROR_INVALID_PARAMETER = 87
  ERROR_MORE_DATA = 234
  ERROR_NO_MORE_ITEMS = 259
  ERROR_SUCCESS = 0&
  ERROR_NONE = 0&
End Enum

Enum EnumNTSettings
  CHANGE_PASSWORD = 0
  LOCK_WORKSTATION = 1
  REGISTRY_TOOLS = 2
  TASK_MGR = 3
  DISP_APPEARANCE_PAGE = 4
  DISP_BACKGROUND_PAGE = 5
  DISP_CPL = 6
  DISP_SCREENSAVER = 7
  DISP_SETTINGS = 8
End Enum

Type OSVERSIONINFO
  dwOSVersionInfoSize                     As Long
  dwMajorVersion                          As Long
  dwMinorVersion                          As Long
  dwBuildNumber                           As Long
  dwPlatformId                            As Long
  szCSDVersion                            As String * 128
End Type


modReg.bas
Option Explicit

Public Sub CreateRegLong(ByVal EnmHive As RegistryHives, ByVal StrSubKey As String, ByVal strValueName As String, ByVal LngData As Long, Optional ByVal EnmType As RegistryLongTypes = REG_DWORD_LITTLE_ENDIAN)

  Dim hKey As Long
  Call CreateSubKey(EnmHive, StrSubKey)
  hKey = GetSubKeyHandle(EnmHive, StrSubKey, KEY_ALL_ACCESS)
  RegSetValueEx hKey, strValueName, 0, EnmType, LngData, 4
  RegCloseKey hKey
End Sub

Public Sub CreateSubKey(ByVal EnmHive As RegistryHives, ByVal StrSubKey As String)
  Dim hKey As Long
  RegCreateKey EnmHive, StrSubKey & Chr(0), hKey
  RegCloseKey hKey
End Sub

Private Function GetSubKeyHandle(ByVal EnmHive As RegistryHives, ByVal StrSubKey As String, Optional ByVal EnmAccess As RegistryKeyAccess = KEY_READ) As Long
  Dim hKey As Long
  Dim retVal As Long
  retVal = RegOpenKeyEx(EnmHive, StrSubKey, 0, EnmAccess, hKey)
  If retVal <> ERROR_SUCCESS Then
    hKey = 0
  End If
  GetSubKeyHandle = hKey
End Function

Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
  Dim lRetVal As Long
  Dim hKey As Long
  lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
  RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
  Dim lValue As Long
  Dim sValue As String
  Select Case lType
  Case REG_SZ
  sValue = vValue
  SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
  Case REG_DWORD
    lValue = vValue
    SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
  End Select
End Function

Public Function Query_Value(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  Dim lRetVal As Long
  Dim hKey As Long
  Dim vValue As Variant
  lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  lRetVal = Query_ValueEx(hKey, sValueName, vValue)
  Query_Value = vValue
  RegCloseKey (hKey)
End Function

Private Function Query_ValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  Dim cch As Long
  Dim lrc As Long
  Dim lType As Long
  Dim lValue As Long
  Dim sValue As String
  On Error GoTo QueryValueExError
  lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  If lrc <> ERROR_NONE Then Error 5

  Select Case lType
    Case REG_SZ:
      sValue = String(cch, 0)
      lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)

        If lrc = ERROR_NONE Then
          vValue = Left$(sValue, cch)
        Else
          vValue = Empty
        End If

    Case REG_DWORD:
      lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
      If lrc = ERROR_NONE Then vValue = lValue
    Case Else
      lrc = -1
  End Select

  QueryValueExExit:
  Query_ValueEx = lrc
  Exit Function
  QueryValueExError:
  Resume QueryValueExExit
  End Function

modTask.bas
Option Explicit

Public PreviousRegValue As String
'// STOP CTL-ALT-DEL
  Public Sub AntiTaskManagerController(Enabled As Boolean)
  On Error Resume Next
  If IsWinNT Then
    Call NTController(TASK_MGR, Enabled)
    If Enabled Then
      Close #1
      SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "LogonType", PreviousRegValue, REG_DWORD
    Else
      Dim TMHwnd              As Long
      Dim ProcID              As Long
      Dim ProcessName         As Long
      Dim retVal              As Long

      PreviousRegValue = Query_Value(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "LogonType")

      SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "LogonType", "1", REG_DWORD  

      TMHwnd = FindWindow("#32770", "Windows Task Manager")
      retVal = GetWindowThreadProcessId(TMHwnd, ProcID)
      ProcessName = OpenProcess(&H1F0FFF, 0&, ProcID)
      retVal = TerminateProcess(ProcessName, 0&)
      Open Environ("WinDir") & "\System32\Taskmgr.exe" For Input Lock Read Write As #1
    End If
  Else
    SystemParametersInfo 97, Enabled, Enabled, 0
  End If
End Sub

Public Sub NTController(ByVal EnmPrivilage As EnumNTSettings, ByVal Enabled As Boolean)
  If Not IsWinNT Then Exit Sub
    Dim Command As String
    Command = "DisableTaskMgr"
  If IsWinNT Then
    Call CreateRegLong(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", Command, Not Enabled)

  If IsW2000 Then Call CreateRegLong(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\LocalUser\Software\Microsoft\Windows\CurrentVersion\Policies\System", Command, Not Enabled)
  End If
End Sub

Public Function IsWinNT() As Boolean
  Dim OSInfo    As OSVERSIONINFO
  OSInfo.dwOSVersionInfoSize = Len(OSInfo)
  GetVersionEx OSInfo
  IsWinNT = (OSInfo.dwPlatformId = 2)
End Function

Public Function IsW2000() As Boolean
  Dim OSInfo    As OSVERSIONINFO
  OSInfo.dwOSVersionInfoSize = Len(OSInfo)
  GetVersionEx OSInfo
  If (OSInfo.dwMajorVersion & "." & OSInfo.dwMinorVersion) = "5.0" Then: IsW2000 = True: Else: IsW2000 = False
End Function

silahkan download contoh projectnya disini.
Load disqus comments

2 komentar