Foro de elhacker.net

Option Explicit  
  
'*******************************************************************************  
' Declaraciones Api  
'*******************************************************************************  
  
'Función Api ShellExecute para abrir archivos con su programa asociado  
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _  
    ByVal hWnd As Long, _  
    ByVal lpOperation As String, _  
    ByVal lpFile As String, _  
    ByVal lpParameters As String, _  
    ByVal lpDirectory As String, _  
    ByVal nShowCmd As Long) As Long  
  
'Para saber si se presionó la tecla Shift y F9  
Private Declare Function GetAsyncKeyState Lib "user32" ( _  
    ByVal vKey As Long) As Integer  
  
'*******************************************************************************  
' Variables  
'*******************************************************************************  
  
'Para listar y matar los procesos _  
 mediante WMI ( windows management instrumentation )  
Dim ListaProcesos As Object  
Dim obj_Wmi As Object  
Dim ProcesoACerrar As Object  
  
Private Sub Form_Load()  
    'Procedimiento que configura los _  
     controles y algunas opciones  
    Call iniciar  
      
End Sub  
  
  
'Botones de opción del programa  
'************************************  
  
Private Sub Command1_Click(Index As Integer)  
    On Local Error GoTo men  
      
    Select Case Index  
        Case 0  
            'Agrega mediante un commondialog las rutas al List1  
            Call Agregar_Programa  
        Case 1  
            'Elimina los Items del List1  
            If List1.ListIndex <> -1 Then  
                List1.RemoveItem List1.ListIndex  
            End If  
        'Lista los procesos y los muestra con un MsgBox  
        Case 2  
            Call Listar_Procesos  
        Case 3  
            'Ejecuta el archivo log.txt con los programas que se _  
             intentaron ejecutar y el programa los cerró  
            Call ShellExecute(Me.hWnd, vbNullString, App.Path & _  
                          "\log.txt", vbNullString, vbNullString, 1)  
        Case 4  
            'Elimina los archivos log.txt y rutas.dat  
            If MsgBox("Eliminar el archivo log.txt ?", _  
                      vbInformation + vbYesNo, App.Title) = vbYes Then  
                Kill App.Path & "\log.txt"  
            End If  
              
            If MsgBox("Eliminar el listado de las rutas de los programas?", _  
                      vbInformation + vbYesNo, App.Title) = vbYes Then  
                Kill App.Path & "\rutas.dat"  
                  
                List1.Clear  
            End If  
        Case 5  
            'Pone en Pausa el programa y lo pone en funcionamiento _  
             activando o desactivando el timer1  
            If Command1(5).Caption = "Play" Then  
                Command1(5).Caption = "Pausa"  
                Timer1.Enabled = False  
            Else  
                Command1(5).Caption = "Play"  
                Timer1.Enabled = True  
            End If  
      
            Case 6  
                'Salimos del programa  
                Unload Me  
                End  
            Case 7  
                'Este botón oculta el formulario.  
                MsgBox "Para volver a hacer visible presioná la tecla SHIFT+F9", _  
                        vbInformation, App.Title  
                  
                Timer2.Enabled = True  
                Me.Hide  
  
    End Select  
  
Exit Sub  
men:  
    If Err.Number = 53 Then  
        MsgBox "No hay archivo a eliminar", _  
                vbExclamation, App.Title  
        Resume Next  
    End If  
End Sub  
  
'Sub que agrega un programa cuando _  
 presionamos el Command1(0) (agregar programa)  
'****************************************************************  
Private Sub Agregar_Programa()  
    Dim i As Integer  
      
    CommonDialog1.DialogTitle = "Seleccione el fichero ejecutable" & _  
                                " que desea impedir que se ejecute"  
      
    CommonDialog1.Filter = "Archivos exe|*.exe"  
    CommonDialog1.ShowOpen  
      
    If CommonDialog1.FileName = "" Then  
        Exit Sub  
    End If  
      
    For i = 0 To List1.ListCount - 1  
        If CommonDialog1.FileName = List1.List(i) Then  
            MsgBox "El programa ya está incluido en la lista", _  
                vbInformation, App.Title  
            Exit Sub  
        End If  
    Next  
    ' Agregamos el path al listbox  
    List1.AddItem CommonDialog1.FileName  
    'Lo chequeamos  
    List1.Selected(List1.ListCount - 1) = True  
  
End Sub  
  
'Sub que lista los procesos abiertos y _  
 los muestra con un MsgBox a modo de información  
'*******************************************************************  
Private Sub Listar_Procesos()  
    Dim i As Integer  
    Dim lista() As String  
    Dim lista2 As String  
  
    If IsNull(obj_Wmi) = False Then  
          
        'instanciamos la variable para usar Wmi  
        Set ListaProcesos = obj_Wmi.InstancesOf("win32_process")  
        ReDim lista(ListaProcesos.Count)  
          
        For Each ProcesoACerrar In ListaProcesos  
            lista(i) = LCase(ProcesoACerrar.Name)  
            i = i + 1  
        Next  
          
        For i = LBound(lista) To UBound(lista)  
            lista2 = lista2 & lista(i) & vbNewLine  
        Next  
            MsgBox lista2, vbInformation, App.Title  
        End If  
End Sub  
  
  
'Este Timer chequea si los programas listados en _  
 el List están en ejecución y si lo está lo cierra  
'*******************************************************************  
Private Sub Timer1_Timer()  
  
Dim i As Integer  
Dim strName As String  
  
    If IsNull(obj_Wmi) = False Then  
  
        'instanciamos la variable  
        Set ListaProcesos = obj_Wmi.InstancesOf("win32_process")  
  
        Label2 = "Procesos ejecutandose: " & ListaProcesos.Count  
  
        'recorremos los items del List, es decir las rutas  
        For i = 0 To List1.ListCount - 1  
            'Obtenemos solo el nombre del Ejecutable  
            strName = LCase(Right(List1.List(i), _  
                      Len(List1.List(i)) - InStrRev(List1.List(i), "\")))  
  
            'Recorremos todos los procesos  
            For Each ProcesoACerrar In ListaProcesos  
                'si el nombre de proceso es igual al del List  
                If strName = LCase(ProcesoACerrar.Name) And _  
                                      List1.Selected(i) Then  
                    DoEvents  
                    '.... lo Matamos  
                    ProcesoACerrar.Terminate (0)  
                    'grabamos en el archivo Log el proceso que acabamos de cerrar  
                    Open App.Path & "\log.txt" For Append As #3  
                      
                    Print #3, "Fecha:" & Date & " " & "Hora:" & _  
                              Time & vbNewLine & strName & vbNewLine  
                    Close #3  
                End If  
  
            Next  
        Next  
    End If  
  
  
End Sub  
  
  
Private Sub Timer2_Timer()  
  
Dim Shift As Long  
Dim EstadoTecla As Long  
  
    Shift = GetAsyncKeyState(vbKeyShift)  
  
    'Esto verifica cuando se presiona la tecla SHIFT+F9 para hace _  
     Visible el formulario nuevamente  
    EstadoTecla = GetAsyncKeyState(vbKeyF9)  
  
    If Shift <> 0 And (EstadoTecla And &H1) = &H1 Then  
        Me.Visible = True  
        Timer2.Enabled = False  
    End If  
End Sub  
  
  
Private Sub Form_Unload(Cancel As Integer)  
  
    Timer1.Enabled = False  
    'Eliminamos las variables de objeto  
  
    Set ListaProcesos = Nothing  
    Set obj_Wmi = Nothing  
      
    'Guardamos las rutas del List1 en el archivo rutas.dat  
    Call GuardarPaths  
  
  
End Sub  
  
  
'Carga los rutas en el List cuando inicia el programa leyendo el archivo rutas.dat  
'*********************************************************************************  
  
Private Sub CargarPaths()  
      
    Dim strPath As String  
    Dim Estado As String  
      
    Open App.Path & "\rutas.dat" For Input As #1  
  
    While Not EOF(1)  
          
        Input #1, strPath, Estado  
          
        List1.AddItem strPath  
          
        If Estado = 1 Then  
            List1.Selected(List1.ListCount - 1) = True  
        Else  
            List1.Selected(List1.ListCount - 1) = False  
        End If  
    Wend  
  
    Close  
  
End Sub  
  
'Esta sub guarda los paths que agregamos al List1 cuando cerramos el programa  
' en el archivo rutas.dat, para poder cargar luego cuando volvamos a abrirlo  
'***************************************************************************  
Private Sub GuardarPaths()  
  
Dim strPath As String  
Dim Estado As String  
Dim i As Integer  
  
    Open App.Path & "\rutas.dat" For Output As #1  
  
    For i = 0 To List1.ListCount - 1  
  
        If List1.Selected(i) = True Then  
            Write #1, List1.List(i), 1 'El 1 es porque está chequeado  
        Else  
            Write #1, List1.List(i), 0 ' No está chequeado  
        End If  
    Next  
    Close  
End Sub  
  
  
'Esta sub configura las propiedades de los controles en tiempo de ejecución  
'*******************************************************************************  
  
Private Sub iniciar()  
  
Dim i As Integer  
  
    'Para no a parecer en el TaskBar  
    App.TaskVisible = False  
  
    'Creamos un objeto para utilizar Wmi para los procesos  
    Set obj_Wmi = GetObject("winmgmts:")  
  
    'Si no existe el archivo de las rutas lo crea  
    If Dir(App.Path & "\rutas.dat") = "" Then  
        Open App.Path & "\rutas.dat" For Output As #1  
        Close  
    Else  
        'Carga el List1 con las rutas de los programas  
        Call CargarPaths  
    End If  
  
    'Propiedades de los botones de opción  
  
    Command1(0).Caption = "Agregar Programa"  
    Command1(1).Caption = "Eliminar Programa"  
    Command1(2).Caption = "Ver Procesos"  
    Command1(3).Caption = "Ver Log"  
    Command1(4).Caption = "Eliminar registro"  
    Command1(5).Caption = "Play"  
    Command1(6).Caption = "Salir"  
    Command1(7).Caption = "Ocultar"  
      
    'Propiedades del formulario  
    With Me  
        .Caption = "Programa para impedir la ejecución de procesos ejecutables"  
        .Width = 1650 * 7 + 150  
        .Height = Command1(0).Height + List1.Height + 1500  
        .BackColor = vbWhite  
    End With  
      
    For i = 0 To 6  
        Command1(i).Move 1650 * i, 35, 1700, 300  
    Next  
        List1.Move 10, Command1(0).Top + Command1(0).Height, _  
                                ScaleWidth, ScaleHeight - 750  
  
    'Propiedades del Label1  
    With Label1  
        .Caption = "Configurar segundos"  
        .AutoSize = True  
        .BackStyle = 0  
        .ForeColor = vbBlue  
        .Font.Bold = True  
        .Move 10, List1.Top + List1.Height + 50  
    End With  
      
    'Propiedades del Label2 que muestra la cantidad de procesos  
    With Label2  
        .Move 1700 * 7, 50  
        .AutoSize = True  
        .BackStyle = 0  
        .ForeColor = vbRed  
        .FontBold = True  
        End With  
      
    'Propiedades del check1  
    With Check1  
        .Value = ComprobarInicio  
        .Caption = "Iniciar con Windows"  
        .ForeColor = vbBlue  
        .BackColor = Me.BackColor  
        .Font.Bold = True  
        .Move Combo1.Left, Label1.Top  
    End With  
  
    'Propiedades del Combo1 que configura el intervalo  
    With Combo1  
          
        For i = 1 To 60  
            .AddItem i  
        Next  
          
        .Text = .List(0)  
        .Move Label1.Width + 50, Label1.Top, 700  
    End With  
    Timer1.Interval = 100  
      
    Timer2.Interval = 100  
    Timer2.Enabled = False  
End Sub  
  
'Redimensiona los controles  
'*************************************************************  
Private Sub Form_Resize()  
    On Local Error Resume Next  
      
    List1.Move 10, Command1(0).Top + Command1(0).Height, _  
                          ScaleWidth, ScaleHeight - 750  
      
    Label1.Move 10, List1.Top + List1.Height + 50  
    Check1.Move 3000, Label1.Top  
    Combo1.Move Label1.Width + 50, Label1.Top, 700  
    Command1(7).Move Me.Width - Command1(7).Width - 200, _  
                                     Check1.Top, 1700, 300  
End Sub  
  
  
'Graba en el registro la ruta del programa y también la elimina  
'***********************************************************************  
Private Sub Iniciar_Con_Windows(iniciar As Boolean)  
    On Error Resume Next  
      
    'El nombre de nuestro Exe  
    Dim NuestroPrograma As String  
    'La Ruta de nuestra aplicación  
    Dim Ruta As String  
  
    'Variable de objeto para leer y escribir _  
     en el registro con Wscript.Shell  
    Dim obj_Wsh As Object  
  
    'Seteamos la variable y creamos la referencia  
    Set obj_Wsh = CreateObject("Wscript.Shell")  
      
    NuestroPrograma = App.EXEName  
  
    Ruta = App.Path & "\" & App.EXEName & ".exe"  
  
    If iniciar Then  
        'Escribimos el valor  
        obj_Wsh.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _  
                          "CurrentVersion\Run\" & NuestroPrograma, Ruta  
    Else  
        obj_Wsh.RegDelete "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _  
                           "CurrentVersion\Run\" & NuestroPrograma  
    End If  
      
    'Eliminamos  
    Set obj_Wsh = Nothing  
  
End Sub  
  
  
'Procedimiento que comprueba y lee del registro si se inicia con el sistema  
'****************************************************************************  
Private Function ComprobarInicio() As Integer  
      
    On Local Error Resume Next  
      
    Dim ret As String  
    'Variable de objeto  
    Dim obj_Wsh As Object  
  
    'Seteamos la variable y creamos la referencia  
    Set obj_Wsh = CreateObject("Wscript.Shell")  
      
    ret = obj_Wsh.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _  
                           "\CurrentVersion\Run\" & App.EXEName)  
    If ret = "" Then  
        ComprobarInicio = 0  
    Else  
        ComprobarInicio = 1  
    End If  
  
End Function  
  
  establece si se inicia al arrancar windows  
'****************************************************************************  
Private Sub Check1_Click()  
    Call Iniciar_Con_Windows(Check1.Value)  
End Sub  
  
Private Sub Combo1_Click()  
    Timer1.Enabled = False  
    Timer1.Interval = CInt(Combo1) * 1000  
    Timer1.Enabled = True  
End Sub  
  
Private Sub Combo1_KeyPress(KeyAscii As Integer)  
    KeyAscii = 0  
End Sub