'HACKER Inc.
' ++++++++++++++++++++++++++ HACKER WORK WINDOW ++++++++++++++++++++++++++
'Модуль для работы с окнами                   (11.05.05)          c) 2005


'go go go!


Const WM_CLOSE = &H10
Const WS_MINIMIZE = &H20000000 ' Style bit 'is minimized'
Const HWND_TOP = 0 ' Move to top of z-order
Const SWP_NOSIZE = &H1 ' Do not re-size window
Const SWP_NOMOVE = &H2 ' Do not reposition window
Const SWP_SHOWWINDOW = &H40 ' Make window visible/active
Const GW_HWNDFIRST = 0 ' Get first Window handle
Const GW_HWNDNEXT = 2 ' Get next window handle
Const GWL_STYLE = (-16) ' Get Window's style bits
Const SW_RESTORE = 9 ' Restore window
Const WS_VISIBLE = &H10000000 ' Window is not hidden
Const WS_BORDER = &H800000 ' Window has a border
Const WS_CLIPSIBLINGS = &H4000000 ' can clip windows
Const WS_THICKFRAME = &H40000 ' Window has thick border
Const WS_GROUP = &H20000 ' Window is top of group
Const WS_TABSTOP = &H10000 ' Window has tabstop
' API Functions Definition
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowWord Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Integer
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private 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
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
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 AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwflags As Long) As Boolean
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) 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

Private Declare Function GetForegroundWindow Lib "user32" () As Long


Const TH32CS_SNAPPROCESS As Long = 2&
Const MAX_PATH As Long = 260

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 * MAX_PATH
End Type
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas 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 Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hWnd As Long)
Private Declare Function GetParent& Lib "user32" (ByVal hWnd As Long)
Dim sPattern As String, hFind As Long


' Public Task Item Structure
Public Type TASK_STRUCT
    TaskName As String
    TaskID As Long
End Type


'Structure filled by FillTaskList Sub call
Public TaskList(250) As TASK_STRUCT


Public Function Get_hWND_Window(WindowName$) As Long
'Возвращает хендл по имени
 Dim hWnd
 hWnd = FindWindow(vbNullString, WindowName$)
 Get_hWND_Window = hWnd
End Function

Public Function Get_Name_ActiveWindows() As String
'Возвращает имя активного
    Dim MyStr As String
    MyStr = String(GetWindowTextLength(GetForegroundWindow) + 1, Chr$(0))
    GetWindowText GetForegroundWindow, MyStr, Len(MyStr)
    Get_Name_ActiveWindows = MyStr
End Function

Public Function Get_hWnd_ActiveWindows() As Long
'Возвращает хендл активного
Get_hWnd_ActiveWindows = Get_hWND_Window(Get_Name_ActiveWindows)
End Function

Public Sub Get_AllWindow(hWnd As Long, OnlyVisible As Boolean, ShowWindowCaption As Boolean)
'Возвращает в Public Type TASK_STRUCT Имя и хендл всех окон
 i = FillTaskList(hWnd, OnlyVisible, ShowWindowCaption)
End Sub

Public Function AnimWindow(hwndWindows As Long, AnimTime As Long, AW_Flags)
'Анимация и эффекты для окна

'Значения для  AW_Flags:
'&H1        'Развертывание слева направо
'&H2        'Развертывание справа налево
'&H4        'Развертывание сверху вниз
'&H8        'Развертывание снизу вверх
'&H10       'Развертывание из центра
'&H10000    'Скрыть окно; Если этот флаг отсутствует - Показать
'&H20000    'Активизировать окно
'&H40000    'Скольжение
'&H80000    'Затемнение
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 AnimateWindow hwndWindows, AnimTime, AW_Flags
End Function

'---------------------------------------------------------------------------------------
Public Function Window_CloseByhWnd(hWnd As Long, meHwnd As Long)
'Закрывает окно по хенделу
SendMessage hWnd, WM_CLOSE, meHwnd, 0
End Function

Public Function Window_SetPos(hWnd As Long, hWndInsertAfter As Long, x As Long, y As Long, cx As Long, cy As Long, wFlags As Long)
'Перемещает окно в заданные кординаты по хендалу

'Описание переменных:
'hWnd - окно которое перемещает
'hWndInsertAfter - хендл этого окна после перемещения
'x - Кордината по высоте
'y - Кордината по ширине
'cx - Ширина окна
'cy - Высота окана
'wFlags - Х.З. (Вроде всегда ноль должен быть)
 SetWindowPos hWnd, hWndInsertAfter, x, y, cx, cy, 0
End Function

Public Function Window_ToTop(hWnd As Long)
'Перемещает окно на верх по хенделу
 BringWindowToTop (hWnd)
End Function

Public Function IsTask(hwndTask As Long) As Boolean
'Возвращает True или False является ли данное оконо видимым
 Dim WndStyle As Long
 Const IsTaskStyle = WS_VISIBLE Or WS_BORDER
 WndStyle = GetWindowLong(hwndTask, GWL_STYLE)
 If (WndStyle And IsTaskStyle) = IsTaskStyle Then IsTask = True
End Function

Public Function Window_Add_Menu(hWnd As Long, mnuCaption As String)
'Добавляет в окно пункт меню

'hWnd - Хендл окна к которому добавляем меню
'mnuCaption - Имя пункта меню

hMenu = GetMenu(hWnd)
Call AppendMenu(hMenu, 0, 0, mnuCaption)
End Function

Public Function Window_show(hWnd As Long, ShowOptions As Byte)
'Куча действий с окном

'Значения ShowOptions:

'0 - Hide
'3 - MAXIMIZE
'6 - MINIMIZE
'9 - RESTORE
'5 - SHOW
'10 -SHOWDEFAULT
'3 - SHOWMAXIMIZED
'2 - SHOWMINIMIZED
'7 - SHOWMINNOACTIVE
'8 - SHOWNA
'4 - SHOWNOACTIVATE
'1 - SHOWNORMAL
ShowWindow hWnd, ShowOptions
End Function
Public Function GetExeFromHandle(hWnd As Long) As String
'Получение полного пути exe-файла из его хэндла
Dim threadID As Long, processID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim i As Integer, szExename As String
threadID = GetWindowThreadProcessId(hWnd, processID)
If threadID = 0 Or processID = 0 Then Exit Function
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&
If hSnapshot = -1 Then Exit Function
uProcess.dwSize = Len(uProcess)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
If uProcess.th32ProcessID = processID Then
i = InStr(1, uProcess.szexeFile, Chr(0))
If i > 0 Then szExename = uProcess.szexeFile
Exit Do
Else
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop
Call CloseHandle(hSnapshot)
GetExeFromHandle = szExename
End Function

Public Function FillTaskList(hWnd As Long, OnlyVisible As Boolean, ShowWindowCaption As Boolean) As Integer
' Нахождения хенделов и имён всех окон и запись их в Public Type TASK_STRUCT
    Dim hwndTask As Long
    Dim intLen As Long
    Dim strTitle As String
    Dim strClass As String
    Dim intClass As Integer
    Dim cnt As Integer
    Dim bTask As Boolean

    For cnt = 0 To 250
        TaskList(cnt).TaskID = 0
        TaskList(cnt).TaskName = ""
    Next cnt
    
    cnt = 0
    ' process all top-level windows in master window list
    hwndTask = GetWindow(hWnd, GW_HWNDFIRST) ' get first window
    Do While hwndTask ' repeat for all windows

        If hwndTask <> hWnd Then
            bTask = IsTask(hwndTask)
           
            
            If bTask = True And OnlyVisible = True Or OnlyVisible = False Then
                intLen = GetWindowTextLength(hwndTask) + 1 ' Get length
                strTitle = Space(intLen) ' Get caption
                intLen = GetWindowText(hwndTask, strTitle, intLen)
    
                If intLen > 0 Then ' If we have anything, add it
                
                    If ShowWindowCaption = True Then
                        TaskList(cnt).TaskName = strTitle
                        TaskList(cnt).TaskID = hwndTask
                        cnt = cnt + 1
                    Else
                        strClass = Space(255)
                        intClass = GetClassName(hwndTask, strClass, 255)
                        strClass = Left(strClass, intClass)
                        TaskList(cnt).TaskName = strClass
                        TaskList(cnt).TaskID = hwndTask
                        cnt = cnt + 1
                    End If
                        
                End If
            End If
        End If
        
        hwndTask = GetWindow(hwndTask, GW_HWNDNEXT)
    Loop
    FillTaskList = cnt
End Function

' Give focus to another Task
Public Sub SwitchTo(hWnd As Long)
    Dim ret As Long
    Dim WStyle As Long ' Window Style bits

   ' Get style bits for window
    WStyle = GetWindowLong(hWnd, GWL_STYLE)
    ' If minimized do a restore
    If WStyle And WS_MINIMIZE Then
        ret = ShowWindow(hWnd, SW_RESTORE)
    End If
    ' Move window to top of z-order/activate; no move/resize
    ret = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
End Sub

Private Function EnumWinProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
'Поиск hwnd процесса на панели задач
Dim k As Long, sName As String
If lParam <> 0 Then
    If IsWindowVisible(hWnd) And GetParent(hWnd) = 0 Then
        sName = Space$(128)
        k = GetWindowText(hWnd, sName, 128)
        If k > 0 Then
            sName = Left$(sName, k)
            If UCase(sName) Like UCase(sPattern) Then
                hFind = hWnd
                EnumWinProc = 0
                Exit Function
            End If
        End If
    End If
Else
    sName = Space$(128)
    k = GetWindowText(hWnd, sName, 128)
    If k > 0 Then
        sName = Left$(sName, k)
        If UCase(sName) Like UCase(sPattern) Then
            hFind = hWnd
            EnumWinProc = 0
            Exit Function
        End If
    End If
End If
EnumWinProc = 1
End Function
Public Function FindWindowWild(sWild As String, Optional OnlyTaskBar As Boolean = True) As Long      '(Вызывать эту!)
'Возвращает hwnd процесса на панели задач по имени
sPattern = sWild
EnumWindows AddressOf EnumWinProc, OnlyTaskBar
FindWindowWild = hFind
End Function
'-----------------------------------------

'Методом "через попку"

Open "C:\tmp.bat" For Output As #1
Print #1, "tasklist /V > C:\file.txt"
Close #1
Shell "C:\tmp.bat"
Kill "C:\tmp.bat"

Open "C:\file.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, Str$

'Ну далее разбираешь этот файл, анализируешь, ну итп...
Loop

как запретить или перехватить(а потом запретить) завершение процессов