Foro de elhacker.net

Option Explicit

Private Sub Form_Load()
   
   If App.PrevInstance Then End
   Call SetWindowPos(Me.Hwnd, -1, 0, 0, 0, 0, &H2 Or &H1)
   
   MsgBox "Ejecutar Compilado " + vbCrLf + vbCrLf + "Taskkill no Guarda cambios en las Aplicaciones abiertas, cierra directamente", vbCritical, "Atención"
   
   Me.Caption = "Ejecutar Compilado": Me.Top = 1680: Me.Left = 1560
   Option1.Caption = "Cerrar con  Taskill   (No pide ni guarda nada, cierra todo)"
   Option2.Caption = "Cerrar con API  SendMessage  (Pedirá guardar Cambios)"
   Check1.Caption = "Incluir  Ventanas  sin  Bordes   ( Cerrará el explorer )"
   Option1.Left = 120: Option1.Width = 4465: Option1.Top = 960
   Option2.Value = True
   Option2.Left = 120: Option2.Width = 4465: Option2.Top = 360
   Check1.Left = 120: Check1.Width = 4465: Check1.Top = 2460
   Command1.Caption = "Aceptar"
   Command1.Left = 1560: Command1.Top = 1680

End Sub

Private Sub Command1_Click()
  
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
  
If Check1.Value = 1 Then
  Dim x As Long: x = GetTickCount: While GetTickCount < x + 500: Wend
  Shell "explorer.exe"
End If

End Sub

Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal Hwnd As Long, lpdwprocessid As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Const IsTask = &H10000000 Or &H800000 'solo ventanas visibles y con bordes
Const IsTask2 = &H10000000 ' solo ventanas visibles

Public Function EnumWindowsProc(ByVal Hwnd As Long, ByVal lParam As Long) As Boolean
  If TaskWindow(Hwnd) Then
    If GetClsName(Hwnd) <> "Shell_TrayWnd" Then
      If Form1.Option1.Value = True Then
        Dim idProc As Long: Call GetWindowThreadProcessId(Hwnd, idProc)
        Dim Handle_Proceso As Long: Handle_Proceso = OpenProcess(&H400 + &H10, 0, idProc)
        Dim Buffer As String: Buffer = Space(255)
        Dim ret As Long: ret = GetModuleFileNameExA(Handle_Proceso, 0, Buffer, 255)
        Dim ruta As String: ruta = Left(Buffer, ret)
        Call CloseHandle(Handle_Proceso)
        If Mid(ruta, InStrRev(ruta, "\") + 1) <> App.EXEName + ".exe" Then
          Shell "cmd.exe /c Taskkill /f /IM " + Mid(ruta, InStrRev(ruta, "\") + 1)
        End If
      End If
      If Form1.Option2.Value = True Then
        If Hwnd <> Form1.Hwnd Then Call SendMessage(Hwnd, &H112, &HF060&, 0)
      End If
    End If
  End If
  
  'If EnumWindowsProc = False Then Open App.Path & "\archivo.txt" For Append As #1: Print #1, GetClsName(Hwnd): Close #1
 
  EnumWindowsProc = True

End Function

Private Function TaskWindow(hwCurr As Long) As Long
  Dim lngStyle As Long: lngStyle = GetWindowLong(hwCurr, (-16))
  If Form1.Check1.Value = 0 Then If (lngStyle And IsTask) = IsTask Then TaskWindow = True
  If Form1.Check1.Value = 1 Then If (lngStyle And IsTask2) = IsTask2 Then TaskWindow = True
End Function

Private Function GetClsName(handle As Long) As String
    Dim lpClassName As String: lpClassName = Space(256)
    Dim RetVal As Long: RetVal = GetClassName(handle, lpClassName, 256)
    GetClsName = Left$(lpClassName, RetVal)
End Function