Keskustelu: Koodit: VB6: Estä ctrl+alt+del parempi versio

Option Explicit

Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16 'tässä määritellään apit turhaa alan selittää ku en tajuu ittekkään niistä paljoo
Private Sub Form_Load()
    Dim intCnt As Integer
    intCnt = KillProcByName("\taskmgr.exe")
    ' no formin loadissa tapetaan mahdollisesti päällä oleva taskmanageri
  End Sub
Private Function KillProcByName(ByVal strProcName As String) As Integer
    Dim lngRet As Long
    Dim lngCb As Long, lngCbNeeded As Long, lngCbNeeded2 As Long
    Dim intLoop As Integer
    Dim lngProc As Long, lngProcIDs() As Long
    Dim lngModules(0) As Long, strModule As String
    lngCb = 8
    lngCbNeeded = 96
    Do While lngCb <= lngCbNeeded
        lngCb = lngCb * 2
        ReDim lngProcIDs(lngCb / 4) As Long
        lngRet = EnumProcesses(lngProcIDs(0), lngCb, lngCbNeeded)
    Loop
    For intLoop = 1 To (lngCbNeeded / 4)
        lngProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ Or PROCESS_TERMINATE, 0, lngProcIDs(intLoop))
        If lngProc <> 0 Then
            lngRet = EnumProcessModules(lngProc, lngModules(0), 1, lngCbNeeded2)
            If lngRet <> 0 Then
                strModule = Space(256)
                Call GetModuleFileNameExA(lngProc, lngModules(0), strModule, Len(strModule))
                strModule = Left(strModule, InStr(1, strModule, vbNullChar) - 1)
                If StrComp(Right(strModule, Len(strProcName)), strProcName, vbTextCompare) = 0 Then
                    Call TerminateProcess(lngProc, 0)
                    KillProcByName = KillProcByName + 1
                End If
            End If
        End If
        Call CloseHandle(lngProc)
    Next intLoop
   End Function

Private Sub Timer1_Timer()
' tässä timeri terminoi joka esim 500 millisekuntti taskmanagerin
 Dim intCnt As Integer
    intCnt = KillProcByName("\taskmgr.exe")
End Sub