Mas mula el programa jajkakajaka
pero se hace lo que se puede
para el que le sirva parte del codigo,
nuevas ideas, etc... haganlo *****
Controles:
- 2 cajas de texto (txtRuta y txtBicho)
- 3 botones (cmdBuscar, malo y Command2)
- 1 CommonDialog (AbrirArchivo)
- 1 Listbox (List1) (carga procesos)
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private 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
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
Const PROCESS_TERMINATE = &H1
Const PROCESS_CREATE_THREAD = &H2
Const PROCESS_VM_OPERATION = &H8
Const PROCESS_VM_READ = &H10
Const PROCESS_VM_WRITE = &H20
Const PROCESS_DUP_HANDLE = &H40
Const PROCESS_CREATE_PROCESS = &H80
Const PROCESS_SET_QUOTA = &H100
Const PROCESS_SET_INFORMATION = &H200
Const PROCESS_QUERY_INFORMATION = &H400
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
////// Pausar
Sub Pause(interval)
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub
///// Rellenar List1 con procesos activos
Sub RellenaLista()
Dim hSnapShot As Long
Dim uProceso As PROCESSENTRY32
Dim res As Long
List1.Clear
hSnapShot = CreateToolhelpSnapshot(2&, 0&)
If hSnapShot <> 0 Then
uProceso.dwSize = Len(uProceso)
res = ProcessFirst(hSnapShot, uProceso)
Do While res
List1.AddItem Left$(uProceso.szExeFile, InStr(uProceso.szExeFile, Chr$(0)) - 1)
List1.ItemData(List1.NewIndex) = uProceso.th32ProcessID
res = ProcessNext(hSnapShot, uProceso)
Loop
Call CloseHandle(hSnapShot)
End If
End Sub
////// Buscar el ejecutable en cuestion
Private Sub cmdBuscar_Click()
With AbrirArchivo
.Filter = "Bichos Ejecutables! (*.exe)|*.exe"
.DialogTitle = "Buscando Bicho a Exterminar !!"
.ShowOpen
If .FileTitle = "" Then
malo.Visible = False
Exit Sub
End If
End With
txtBicho = AbrirArchivo.FileTitle
cuadro1.Caption = "Archivo " & "|" & AbrirArchivo.FileTitle & "|"
txtRuta = AbrirArchivo.FileName
RellenaLista
malo.Visible = False
End Sub
////// Manda a la cresta el proceso y elimina el archivo
Private Sub Command2_Click()
malo.Visible = True
RellenaLista
Dim hProcess As Long, iResult As Long, Resp As Integer
List1.Text = txtBicho
If List1.Text = txtBicho Then
hProcess = OpenProcess(PROCESS_TERMINATE, True, List1.ItemData(List1.ListIndex))
iResult = TerminateProcess(hProcess, 99)
CloseHandle hProcess
DoEvents
Kill txtRuta
Pause 2
MsgBox " Matanga dijo la changa !! ", vbInformation, "Bicho Elimindo!"
malo.Visible = True
Else
Resp = MsgBox("No existe proceso activo..." & vbCrLf & "Desea eliminar el archivo?", vbQuestion + vbYesNo, "Eliminar Bicho?")
If Resp = 7 Then malo.Visible = False
If Resp = 6 Then Kill txtRuta: Pause 2: MsgBox " Matanga dijo la changa !! ", vbInformation, "Bicho Elimindo!": malo.Visible = True
Exit Sub
End If
End Sub
////// Rellena el List1 al cargar el formulario po
Private Sub Form_Load()
RellenaLista
End Sub
jakjkaja
y eso era po
al que le sirva
Chauuuuuz
Saludos desde Chile
Mostrar Temas
