Task Process Monitoring

bukanintrik

Saturday, September 11, 2010

Baca Juga

Pengganti Task Manager yang mungkin tidak bisa diakses karena ulah Virus Local :)

1. Form
     List View              [Name = info]
     CommandButton   [Name = cmdCloseProcess] [Caption = Terminate]
     CommandButton   [Name = Command1] [Caption = Exit]
     Timer                    [Name = updateTimer] [Interval = 1000]
     Timer                    [Name = Cap] [Interval=20]
     Label                    [Name = Label1]
2. Module

Form Design

Code Program :

- FORM -
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
           
Dim hSnapshot As Long
Dim processInfo As PROCESSENTRY32
Dim success As Long
Dim exeName As String
Dim retval As Long
Dim itm As ListItem
Dim ProsesName(100), ProsesID(100), PArentID(100)
Dim ProsesExplorer, ExplorerID, cnt, VirusID, PID
Dim virusFound As Boolean

Private Sub Initproses()
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
    processInfo.dwSize = Len(processInfo)
    success = Process32First(hSnapshot, processInfo)
    If hSnapshot = -1 Then
       Exit Sub
    End If

    items2 = 0
    While success <> 0
          items2 = items2 + 1
          success = Process32Next(hSnapshot, processInfo)
    Wend
    retval = CloseHandle(hSnapshot)
    If items1 <> items2 Then
       hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
       processInfo.dwSize = Len(processInfo)
       success = Process32First(hSnapshot, processInfo)
       cnt = 1
       info.ListItems.Clear
       While success <> 0
            
             exeName = Left(processInfo.szExeFile, InStr(processInfo.szExeFile, vbNullChar) - 1)
             Set itm = info.ListItems.Add(cnt, , exeName)
             ProsesName(cnt) = GetFileName(exeName)
             ProsesID(cnt) = processInfo.th32ProcessID
             PArentID(cnt) = processInfo.th32ParentProcessID
             itm.Tag = exeName
             itm.SubItems(1) = processInfo.th32ProcessID
             itm.SubItems(2) = processInfo.th32ParentProcessID
             itm.SubItems(3) = processInfo.cntThreads
             itm.SubItems(4) = processInfo.cntUsage
             itm.SubItems(5) = processInfo.th32ModuleID
             itm.SubItems(6) = processInfo.th32DefaultHeapID
             itm.SubItems(7) = processInfo.pcPriClassBase

             cnt = cnt + 1
             processInfo.dwSize = Len(processInfo)
             success = Process32Next(hSnapshot, processInfo)
       Wend
       retval = CloseHandle(hSnapshot)
       Label1.Caption = cnt - 1 & " Proses Program sedang berjalan - Task Process Monitoring"
       items1 = items2
     End If
End Sub

Private Sub Cap_Timer()
    If Label1.Left < 0 - Label3.Width Then
      DoEvents
        Label1.Left = 4350
    End If
    Label1.Left = Label3.Left - 20
       
    Select Case Label1.ForeColor
        Case vbBlue: Label1.ForeColor = vbRed
        Case vbRed: Label1.ForeColor = vbMagenta
        Case vbMagenta: Label1.ForeColor = vbBlue
    End Select
   
End Sub

Private Sub cmdCloseProses_Click()
    opPROS = OpenProcess(1, 0, info.SelectedItem.SubItems(1))
    If opPROS <> "" Then
        TerminateIt = TerminateProcess(opPROS, 0)
        If TerminateIt = False Then
            f = MsgBox("Proses " & info.SelectedItem.Text & " tidak bisa dihentikan...!!!", vbCritical, "Task Process Monitoring")
        End If
    End If
    CloseHandle (opPROS) 
End Sub

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    Label3.Left = 4350
    PID = ""
    virusFound = True
    Initproses
    item1 = 0
    Call CekProses
End Sub

Private Sub CariExplorer()
    For i = 1 To cnt
        If LCase(ProsesName(i)) = "explorer.exe" Then
            ExplorerID = ProsesID(i)
        End If
    Next
End Sub

Private Sub CekProses()
    For i = 1 To cnt
        If (LCase(ProsesName(i)) = "winlogon.exe") And PArentID(i) = ExplorerID Then
            VirusID = ProsesID(i)
            virusFound = True
            PID = PID & "/PID " & VirusID & " "
            MsgBox (VirusID)
           
        ElseIf (LCase(ProsesName(i)) = "lsass.exe") And PArentID(i) = ExplorerID Then
            VirusID = ProsesID(i)
            virusFound = True
            PID = PID & "/PID " & VirusID & " "
            MsgBox (VirusID)
           
        ElseIf (LCase(ProsesName(i)) = "inetinfo.exe") And PArentID(i) = ExplorerID Then
            VirusID = ProsesID(i)
            virusFound = True
            PID = PID & "/PID " & VirusID & " "
            MsgBox (VirusID)
        ElseIf (LCase(ProsesName(i)) = "services.exe") And PArentID(i) = ExplorerID Then
            VirusID = ProsesID(i)
            virusFound = True
            PID = PID & "/PID " & VirusID & " "
            MsgBox (VirusID)
        Else
            virusFound = False
        End If
    Next
End Sub

Private Sub KillVirus(ID)
    On Error Resume Next
    Shell "C:\WINDOWS\SYSTEM32\Taskkill.exe /f " & PID, vbHide
    Initproses
End Sub

Private Sub updateTimer_Timer()
    updateTimer.Enabled = False
    Call Initproses
    updateTimer.Enabled = True
End Sub

-MODULE-

Public Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long

Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
End Type
Public Const TH32CS_SNAPALL = &HF
Public Const WM_CLOSE = &H10
Public items1 As Long
Public items2 As Long

Public Function GetFileName(FullPath As String) As String
       On Error Resume Next
       Dim dta As String
       Dim ch As String
       Dim plen As Long
       Dim cnt As Integer
       plen = Len(FullPath)
       cnt = 0
       ch = Mid$(FullPath, plen, 1)
       While ch <> "\" And cnt < plen
            dta = ch & dta
            cnt = cnt + 1
            ch = Mid$(FullPath, plen - cnt, 1)
       Wend
       GetFileName = dta
End Function

Running Program

Labels: Pemrograman, VB Source Code

Thanks for reading Task Process Monitoring. Please share...!