'HACKER Inc.
' ++++++++++++++++++++++++++ HACKER WORK WINDOW ++++++++++++++++++++++++++
'Модуль для работы с окнами                   (14.08.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
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) 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 GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) 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

Private Const PROCESS_QUERY_INFORMATION As Long = 1024
Private Const PROCESS_VM_READ       As Long = 16

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

'C language TypeDef to hold the size information for a given window.
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom 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 GetAllModuleFromHandle(hWnd As Long, arr() As String)
'Получение сведений о загруженных модулях процесса из хэндла окна
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 'Нашли PID процесса

Call GetAllModule(processID, arr()) 'Вызвали функцию возвращающую инфо по PID
' arr(0) полный путь к exe
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
'-----------------------------------------

Public Sub GetWindowsRECT(hWnd As Long, ProcID As Integer, Height As Integer, Top As Integer, Left As Integer, Witch As Integer)
'Возвращает информацию о окне: кординаты, высоту, ширину
Dim rctTemp As RECT

     GetWindowThreadProcessId hWnd, lngProcID
     GetWindowRect hWnd, rctTemp
     
     'Load the labels with the info retrieved.
ProcID = lngProcID
Top = rctTemp.Top
Left = rctTemp.Left

Height = rctTemp.Bottom - Top
Witch = rctTemp.Right - Left

End Sub


Private Sub GetAllModule(pID As Long, arr() As String)
'Возвращает информацию о загруженных модулях в определённом процессе
    Dim i As Long
    Dim hProcess As Long
    Dim cb As Long
    Dim cbNeeded As Long
    Dim mID() As Long
    Dim nModules As Long
    Dim mName As String
    ReDim arr(0)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pID)
    If hProcess <> 0 Then
       cb = 8
       cbNeeded = 96
       Do While cb <= cbNeeded
          cb = cb * 2
          ReDim mID(cb / 4)
          Call EnumProcessModules(hProcess, mID(1), cb, cbNeeded)
       Loop
       nModules = cbNeeded / 4
       If nModules > 0 Then
            mName = String(MAX_PATH, 0)
            For i = 0 To UBound(mID)
                Call GetModuleFileNameExA(hProcess, mID(i), mName, MAX_PATH)
                arr(i) = Trim(mName)
                ReDim Preserve arr(UBound(arr) + 1)
                'кроме "*.exe" файла здесь будет найдено много всяких "*.dll", "*.ocx"
                'и возможно еще что ни - будь, скорее всего, путь к файлу, запустившему процесс
                'будет получен при i = 0
            Next i
            arr(UBound(arr)) = "PID окна процесса: " & pID
       End If
    End If
    Call CloseHandle(hProcess)
End Sub