• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Ridelight

[VB6] Impedir que a aplicação seja encerrada atraves do CTRL+ALT+DEL

8 mensagens neste tópico

Criem o seguinte módulo

Public Declare Function GetCurrentProcessId Lib _"kernel32" () As Long
Public Declare Function GetCurrentProcess Lib _"kernel32" () As Long
Public Declare Function RegisterServiceProcess _Lib "kernel32" (ByVal dwProcessID As Long, _ByVal dwType As Long) As Long
Public Const RSP_SIMPLE_SERVICE As Long = 1
Public Const RSP_UNREGISTER_SERVICE As Long = 0

Criem a seguinte Sub:

Public Sub MakeMeService()
Dim pid As Long
Dim reserv As Long
pid = GetCurrentProcessId()
reserv = RegisterServiceProcess(pid,RSP_SIMPLE_SERVICE)
End Sub

Depois coloquem o seguinte no FORM_LOAD:

Private Form_Load()
MakeMeService
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

não seria bom ter uma coisa tipo:

Public Sub MakeMeService_unload()
Dim pid As Long
Dim reserv As Long
pid = GetCurrentProcessId()
reserv = RegisterServiceProcess(pid,RSP_UNREGISTER_SERVICE)
End Sub

e depois

Private Form_UnLoad()
MakeMeService_unload
End Sub

?? so a laia da precaução

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Qual seria o respectivo codigo em VB 2005? Agradeçido :)

Vê isto:

Option Strict On
Option Explicit On 
Imports System.Threading
Imports System.Reflection
Imports System.Runtime.InteropServices
Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(292, 266)
        Me.Name = "Form1"
        Me.Text = "Form1"

    End Sub

#End Region

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        HookKeyboard()
        apiSystemParametersInfoA(SPI_SETKEYBOARDDELAY, -1, 0, 0)
        apiSystemParametersInfoA(SPI_SETKEYBOARDSPEED, 1, 0, 0)
    End Sub

    Private Sub Form1_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
        UnhookKeyboard()
        apiSystemParametersInfoA(SPI_SETKEYBOARDDELAY, 20, 0, 0)
        apiSystemParametersInfoA(SPI_SETKEYBOARDSPEED, 20, 0, 0)
    End Sub

    Public Function IsHooked(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        On Error Resume Next

        ' block task manager from the ctrl alt delete combo
        If (Hookstruct.vkCode = Keys.Delete OrElse CBool(apiGetAsyncKeyState(Keys.Delete) And &H8000) = True) AndAlso (Hookstruct.vkCode = VK_CONTROL OrElse CBool(apiGetAsyncKeyState(VK_CONTROL) And &H8000) = True) AndAlso (Hookstruct.vkCode = Keys.Menu OrElse CBool(apiGetAsyncKeyState(Keys.Menu) And &H8000) = True) Then Return KillTaskMgr()

        'block task manager from the control alt escape combo
        If (Hookstruct.vkCode = Keys.Escape OrElse CBool(apiGetAsyncKeyState(Keys.Escape) And &H8000) = True) AndAlso CBool(apiGetAsyncKeyState(VK_CONTROL) And &H8000) AndAlso CBool(apiGetAsyncKeyState(Keys.Shift) And &H8000) Then Return KillTaskMgr()

        If (Hookstruct.vkCode = Keys.RWin) Then Return True 'block right win key

        If (Hookstruct.vkCode = Keys.LWin) Then Return True 'block left win key   

        'Block ctrl escape  Stops from opening the start menu, as above with win keys.
        If CBool(apiGetAsyncKeyState(VK_CONTROL) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.Escape Then Return True

        'Block control F4  Stops the closing of a window within an application without closing the main application
        If CBool(apiGetAsyncKeyState(VK_CONTROL) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.F4 Then Return True

        'Block Alt F4 from directly closing this the application
        If CBool(apiGetAsyncKeyState(Keys.Menu) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.F4 Then Return True

        'Block Alt Space Stops the opening of the titlebar menu, that can close the alt+f4 combo above
        If CBool(apiGetAsyncKeyState(Keys.Menu) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.Space Then Return True

        'Stop from switching focus to previous application
        If CBool(apiGetAsyncKeyState(Keys.Menu) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.Tab Then Return True

        'Stop from switching focus to previous application
        If CBool(apiGetAsyncKeyState(Keys.Menu) And &H8000) = True AndAlso Hookstruct.vkCode = Keys.Escape Then Return True

        'block any keys you like here, ie a.
        '  If Hookstruct.vkCode = Keys.A Then Return True


        Return False
    End Function
    Public Function KillTaskMgr() As Boolean
        On Error Resume Next
        Dim i As Int32
        Do
            Dim clt() As Process = Process.GetProcessesByName("taskmgr")
            For Each p As Process In clt
                p.Kill()
            Next
            Thread.Sleep(1)
            i += 1
            If i = 200 Then Exit Do 'Set this no larger then the registry's timeout for keyboard hooks.  TODO
        Loop
    End Function

    Const VK_CONTROL As Int32 = &H11
    Const SPI_SETKEYBOARDDELAY As Int32 = 23
    Const SPI_SETKEYBOARDSPEED As Int32 = 11
    Public Structure KBDLLHOOKSTRUCT
        Public vkCode, scanCode, flags, time, dwExtraInfo As Int32
    End Structure
    Public Delegate Function KeyboardHookDelegate(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
    <MarshalAs(UnmanagedType.FunctionPtr)> Private callback As KeyboardHookDelegate
    Public KeyboardHandle As Int32
    Private Declare Function apiGetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Int32) As Int32
    Private Declare Function apiSetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Int32, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Int32, ByVal dwThreadId As Int32) As Int32
    Private Declare Function apiCallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal hHook As Int32, ByVal nCode As Int32, ByVal wParam As Int32, ByVal lParam As KBDLLHOOKSTRUCT) As Int32
    Private Declare Function apiUnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHook As Int32) As Int32
    Private Declare Function apiSystemParametersInfoA Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Int32, ByVal uParam As Int32, ByVal lpvParam As Int32, ByVal fuWinIni As Int32) As Int32
    Dim clt() As Process = Process.GetProcessesByName("taskmgr")
    Public Sub HookKeyboard()
        callback = New KeyboardHookDelegate(AddressOf KeyboardCallback)
        KeyboardHandle = apiSetWindowsHookEx(13&, callback, Marshal.GetHINSTANCE([Assembly].GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
    End Sub
    Public Sub UnhookKeyboard()
        If Hooked() = True Then Call apiUnhookWindowsHookEx(KeyboardHandle)
    End Sub
    Private Function Hooked() As Boolean
        Return KeyboardHandle <> 0
    End Function
    Public Function KeyboardCallback(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
        If (Code = 0) = True AndAlso (IsHooked(lParam)) = True Then Return 1
        Return apiCallNextHookEx(KeyboardHandle, Code, wParam, lParam)
    End Function
End Class

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Insiro todo esse código no inicio da Class? Tanto no fim como no inicio dão bastantes erros :S

Explica-me melhor isto sff RL ... =)

Cumpz :D

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Este código não dá nenhum erro se o meteres todo dentro de um Module ou se na "class" não deixares ficar nem o "public class" nem o "end class".

Ás vezes fico com dúvidas se andas na mesma turma que eu ?  :biggrin:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

LuiSinhobiKer,

Este código é todo do From1, não é necessário criar módulos nem classes. No entanto com o código de design do form é criado normalmente num ficheiro escondido (na versão 2002/2003 isto não acontecia!) é necessário apagar parte da informação. O que se encontra dentro da Region “Windows Form Designer generated code” deve ser apagado podendo o resto ficar apenas na classe/form principal.

Este código serve apenas para desabilitar o acesso ao task manager através da combinação de teclas CTRL+ALT+DEL e para que funcione bem a aplicação deve ser maximizada e modal (Me.TopMost = True).

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Criem o seguinte módulo

Public Declare Function GetCurrentProcessId Lib _"kernel32" () As Long
Public Declare Function GetCurrentProcess Lib _"kernel32" () As Long
Public Declare Function RegisterServiceProcess _Lib "kernel32" (ByVal dwProcessID As Long, _ByVal dwType As Long) As Long
Public Const RSP_SIMPLE_SERVICE As Long = 1
Public Const RSP_UNREGISTER_SERVICE As Long = 0

Criem a seguinte Sub:

Public Sub MakeMeService()
Dim pid As Long
Dim reserv As Long
pid = GetCurrentProcessId()
reserv = RegisterServiceProcess(pid,RSP_SIMPLE_SERVICE)
End Sub

Depois coloquem o seguinte no FORM_LOAD:

Private Form_Load()
MakeMeService
End Sub

Desculpem mas eu tentei utilizar e deu um erro que é o seguinte.

"Can't find DLL entry point RegisterServiceProcess in kernel32"

e faço debug e aparece que o erro que existe é este "reserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)"

por favor ajudem-me porque eu tenho tenho que apresentar o trabalho para avaliação e o meu programa é um Lan-House....

Cumprimentos Nelson Alves

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora