No Administrador de Tareas

no esta mal, nada mal xo ay un codigo que hace lo mismo mediante regsitros solo que sale un mensaje de error en vez del taskmanager, podrian ser buna convinacion!

Aqui va el codigo que no es mio:

Form1

Código:

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim SystemPath As String
Dim OS As String

Private Sub cmdDisable_Click()
If (OS = 1) Then
KeysOff
Else
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", REG_DWORD, "DisableTaskMgr", "1"
End If
End Sub

Private Sub cmdEnable_Click()
If (OS = 1) Then
KeysOn
Else
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", REG_DWORD, "DisableTaskMgr", "0"
End If

End Sub

Private Sub Form_Load()
Dim lpBuffer As String
Dim nSize As Integer
Dim rc As Long

nSize = 255
lpBuffer = Space$(nSize)
rc = GetSystemDirectory(lpBuffer, nSize)
If (rc <> 0) Then
SystemPath = Left$(lpBuffer, InStr(lpBuffer, Chr$(0)) - 1)
Else
SystemPath = ""
End If
If (Len(SystemPath) = 17) Then
OS = 1 ' windows 98
Else
OS = 2
End If
End Sub

Mod1:

Código:

' NOTE: ScaleMode of this module is pixels.
' It means all of parameters must be in pixels.

' All of variables in this module must be declared.
Option Explicit

'Structure to pass mouse pointer info to and from DLLs.
Public Type usrPOINTAPI
X As Long
Y As Long
End Type

'Structure to pass rectangle info to and from DLLs.
Public Type usrRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Windows API declarations
Public Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal aBOOL As Integer) As Integer
Public Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Sub ClipCursor Lib "user32" (lpRect As usrRECT)
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Sub GetWindowRect Lib "user32" Alias "GetWindowRECT" (ByVal hWnd As Long, lpRect As usrRECT)

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function ShowCursor Lib "user32" (ByVal blnSHOW As Long) As Long

' Variable declarations
Public lngTASKBARHWND As Long ' Taskbar Handler
Public intISTASKBARENABLED As Integer ' Determines Windows taskbar is enable or disable
Public intS_1 As Integer ' Will be used to hide/show mouse cursor

' This procedure enables the following
' keys in Windows:
' 1. Ctrl+Alt+Del [Close Program]
' 2. Alt+Tab [Quick Program Select]
' 3. Ctrl+Esc [Open Start Menu]
Public Sub KeysOn()
Dim lngA As Long, lngDISABLED As Long

lngDISABLED = False
lngA = SystemParametersInfo(97, lngDISABLED, CStr(1), 0)
End Sub

' This procedure disables the following
' keys in Windows:
' 1. Ctrl+Alt+Del [Close Program]
' 2. Alt+Tab [Quick Program Select]
' 3. Ctrl+Esc [Open Start Menu]
Public Sub KeysOff()
Dim lngA As Long, lngDISABLED As Long

lngDISABLED = True
lngA = SystemParametersInfo(97, lngDISABLED, CStr(1), 0)
End Sub

' This procedure disables Windows taskBar,
' but taskbar will be visible.
Public Sub DisableTaskBar()
Dim EWindow As Integer

lngTASKBARHWND = FindWindow("Shell_traywnd", "")
If lngTASKBARHWND <> 0 Then
EWindow = IsWindowEnabled(lngTASKBARHWND)
If EWindow = 1 Then _
intISTASKBARENABLED = EnableWindow(lngTASKBARHWND, 0)
End If
End Sub

' This procedure enables Windows taskBar.
Public Sub EnableTaskBar()
If intISTASKBARENABLED = 0 Then _
intISTASKBARENABLED = EnableWindow(lngTASKBARHWND, 1)
End Sub

' Pass a set of points as a rectangle and
' the mouse cursor will be limited to
' move only in that region.
Public Sub LimitCursor(Left, Top, Right, Bottom As Long)
Dim rctBox As usrRECT

rctBox.Left = Left
rctBox.Top = Top
rctBox.Right = Right
rctBox.Bottom = Bottom
ClipCursor rctBox
End Sub

' This procedure resets the cursor limit back to
' entire screen (turns limiting off)
Public Sub LimitCursorOff()
Dim rctBox As usrRECT
Dim hwndDesktop As Long

hwndDesktop = GetDesktopWindow()
GetWindowRect hwndDesktop, rctBox
ClipCursor rctBox
End Sub

' This procedure makes mouse cursor visible.
Public Sub CursorOn()
Dim intS_2 As Integer
intS_2 = ShowCursor(True)
Do While intS_2 < intS_1
intS_2 = ShowCursor(True)
Loop
End Sub

' This procedure makes mouse cursor unvisible.
Public Sub CursorOff()
Dim intS_2 As Integer
intS_2 = ShowCursor(False)
intS_1 = intS_2 + 1
Do While intS_2 > -1
intS_2 = ShowCursor(False)
Loop
End Sub

' This procedure moves the mouse cursor
' to a new place.
Public Sub MoveCursor(X As Long, Y As Long)
Dim lngA As Long
Dim lngNEWX As Long
Dim lngNEWY As Long

lngNEWX = X
lngNEWY = Y
lngA = SetCursorPos(lngNEWX, lngNEWY)
End Sub

' This is the startup procedure.
Public Sub Main()
' Place your extra code here!
End Sub

Mod2:

Código:

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
' Note that if you declare the lpData pa
' rameter as String in RegSetValueEx, you
' must pass it ByVal.

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 RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

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

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

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_WRITE = &H20006
Public Const KEY_ALL_ACCESS = &H2003F
Public Const KEY_READ = _
((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
' Registry location
Public Const gREGKEYLocation = "SOFTWARE\Your Company Name\Your App Name\Your Current Version"
Public Const gREGKEYXPos = "XPos"
Public Const gREGKEYYPos = "YPos"
Public Const gREGKEYWidth = "Width"
Public Const gREGKEYHeight = "Height"
Public Const gREGKEYWindowState = "WindowState"
Public Const ERROR_SUCCESS = 0&

Public Sub GetRegistryKeys()
Dim strXPos$, strYPos$, strHeight$, strWidth$, strWindowState$

GetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, gREGKEYXPos, strXPos
GetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, gREGKEYYPos, strYPos
GetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, gREGKEYWidth, strWidth
GetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, gREGKEYHeight, strHeight
GetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, gREGKEYWindowState, strWindowState
'Checking the Len is faster than checkin
' g if the value equals ""
'MIN_WIDTH and MIN_HEIGHT can be defined
' as the smallest value the window is allo
' wed

If Len(strWidth) <> 0 Then
frmMain.Width = IIf(CInt(strWidth) > MIN_WIDTH, CInt(strWidth), MIN_WIDTH)
Else: frmMain.Width = MIN_WIDTH
End If

If Len(strHeight) <> 0 Then
frmMain.Height = IIf(CInt(strHeight) > MIN_HEIGHT, CInt(strHeight), MIN_HEIGHT)
Else: frmMain.Height = MIN_HEIGHT
End If

'This sets the location of the window to
' what is saved in the registry.
'IF the value does not exist, then it wi
' ll place it in the center of the screen.
'

If Len(strXPos) <> 0 Then
frmMain.Left = IIf(CInt(strXPos) > 0, CInt(strXPos), (Screen.Width - frmMain.Width) / 2)
End If

If Len(strYPos) <> 0 Then
frmMain.Top = IIf(CInt(strYPos) > 0, CInt(strYPos), (Screen.Height - frmMain.Height) / 2)
Else: frmMain.Top = (Screen.Height - frmMain.Height) / 2
End If

'Sets the app up to be either normal, or
' maximized, based on how the user left it
' last

If Len(strWindowState) > 0 Then

Select Case CInt(strWindowState)
Case vbMaximized
frmMain.WindowState = vbMaximized
Case Else
frmMain.WindowState = vbNormal
End Select
End If
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, _
ByRef KeyVal As String) As Boolean
Dim i As Long
Dim rc As Long
Dim hKey As Long
Dim KeyValType As Long
Dim tmpVal As String
Dim KeyValSize As Long

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError

tmpVal = String$(1024, 0)
KeyValSize = 1024

rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If

Select Case KeyValType
Case REG_DWORD

For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Format(Hex(Asc(Mid(tmpVal, i, 1))), "00")
Next
KeyVal = Format$("&h" + KeyVal)
Case REG_SZ
KeyVal = tmpVal
End Select

GetKeyValue = True
rc = RegCloseKey(hKey)
Exit Function

GetKeyError:
GetKeyValue = False
rc = RegCloseKey(hKey)
End Function

Public Sub SetRegistryKeys()
Dim strF1Prefixes$, strF1PrefixesEnabled$
'Deletes the entire key so it can re-wri
' te it. This is an easy way
'to manage values that may need to be sa
' ved with less data. For
'example, if an MRU list upon opening th
' e app has 4 entries, and
'when the app is closed only has three,
' you don't need to worry about
'determining if there is one extra in th
' e registry and deleting it.
DeleteRegKey gREGKEYLocation

'If the window is minimized, then set it
' to a normal size before saving.
'This way it will not be opened in a min
' imized state.
If frmMain.WindowState = vbMinimized Then frmMain.WindowState = vbNormal

'Save the windowstate to the registry
SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYWindowState, frmMain.WindowState

'Put the window at a normal state to set
' the correct window sizes in the registry
'
frmMain.WindowState = vbNormal
'Set all the window positions.

If frmMain.Left >= 0 Then
SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYXPos, frmMain.Left
Else: SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYXPos, 0
End If

If frmMain.Top >= 0 Then
SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYYPos, frmMain.Top
Else: SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYYPos, 0
End If
SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYWidth, frmMain.Width
SetKeyValue HKEY_LOCAL_MACHINE, gREGKEYLocation, REG_DWORD, gREGKEYHeight, frmMain.Height
End Sub

Public Function SetKeyValue(KeyRoot As Long, KeyName As String, lType As Long, SubKeyRef As String, KeyVal As Variant) As Boolean
Dim rc As Long
Dim hKey As Long

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)

If (rc <> ERROR_SUCCESS) Then
Call RegCreateKey(KeyRoot, KeyName, hKey)
End If

Select Case lType
Case REG_SZ
rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_SZ, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
Case REG_BINARY
rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_BINARY, ByVal CStr(KeyVal & Chr$(0)), Len(KeyVal))
Case REG_DWORD
rc = RegSetValueEx(hKey, SubKeyRef, 0&, REG_DWORD, CLng(KeyVal), 4)
End Select
If (rc <> ERROR_SUCCESS) Then GoTo SetKeyError

SetKeyValue = True
rc = RegCloseKey(hKey)

Exit Function
SetKeyError:
KeyVal = ""
SetKeyValue = False
rc = RegCloseKey(hKey)
End Function

Public Function DeleteRegValue(KeyName As String, SubKeyRef As String) As Boolean
Dim rc As Long
Dim hKey As Long
rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
rc = RegDeleteValue(hKey, SubKeyRef)
If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError
DeleteRegValue = True
Exit Function
DeleteKeyError:
DeleteRegValue = False

End Function

Public Function DeleteRegKey(KeyName As String) As Boolean

Dim rc As Long
'All sub keys must be deleted for this t
' o work.
'If you create key under your original k
' ey, you
'need to delete it forst.
rc = RegDeleteKey(HKEY_LOCAL_MACHINE, KeyName)
DeleteRegKey = IIf(rc = ERROR_SUCCESS, True, False)
End Function

	Bienvenido(a), Visitante. Favor de ingresar o registrarse. ¿Perdiste tu email de activación? - Noviembre 18, 2008, 08:28:13