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 |
