Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Public Declare Function GetParentU Lib "user32" _
Alias "GetParent" (ByVal hwnd As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Public Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" (ByVal hwnd As Long, _
ByVal lpString As String) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
'*********************************************************************************
'
' Функция SVR_GethWndFromProcessID - узнает хэндл(Handle) какого-либо окна по ID процесса.
'
' ПАРАМЕТРЫ:
' hProcessIDToFind - целое число - ID необходимого процесса
'
' ВОЗВРАЩАЕТ:
' Целое число - хэндл(Handle) искомого окна
' Или 0, если окно не найдено
'
'*********************************************************************************
Function SVR_GethWndFromProcessID(ByVal hProcessIDToFind As Long) As Long
Dim hWndDesktop As Long
Dim hWndChild As Long
Dim hWndChildProcessID As Long
Dim hWndMain As Long
On Local Error GoTo GethWndFromProcessID_Error
hWndDesktop = GetDesktopWindow()
hWndChild = GetWindow(hWndDesktop, 5)
Do While hWndChild <> 0
Call GetWindowThreadProcessId(hWndChild, hWndChildProcessID)
If hWndChildProcessID = hProcessIDToFind Then
hWndMain = hWndChild
Exit Do
End If
hWndChild = GetWindow(hWndChild, 2)
Loop
SVR_GethWndFromProcessID = hWndMain
hWndMain = GetParentU(SVR_GethWndFromProcessID)
Do While hWndMain <> 0
SVR_GethWndFromProcessID = hWndMain
hWndMain = GetParentU(SVR_GethWndFromProcessID)
Loop
Exit Function
GethWndFromProcessID_Error:
SVR_GethWndFromProcessID = 0
Exit Function
End Function
'*********************************************************************************
'
' Функция SVR_EXEWait - запускает на выполнение внешнюю программу и ждет ее завершения.
' Есть возможность изменить заголовок окна, запукаемой программы.
'
' ПАРАМЕТРЫ:
' cmdline - строка - команда (программа), которую надо выполнить, включая аргументы.
' caption_str - строка - новый заголовок окна, которое будет открыто.
' Если пустая строка "" - то заголовок не изменяется.
' show - целое число - вид окна, которое будет открыто.
' Допустимые значения:
' 0 - скрытый - окно не показывается
' 1 - нормальный - окно активизируется и отображается с обычными размерами
' в обычном положении
' 2 - свернутый - окно активизируется и отображается в свернутом виде
' 3 - на весь экран - окно активизируется и отображается на весь экран
' 4 - нормальный, не активный - окно отображается с обычными размерами, но оно не активно
' 6 - свернутый, не активный - окно отображается в свернутом виде, но оно не активно
'
' ВОЗВРАЩАЕТ:
' True - Если все прошло удачно
' False - В случае ошибки
'
'*********************************************************************************
Function SVR_EXEWait(ByVal cmdline As String, _
ByVal caption_str As String, _
ByVal show As Long) As Boolean
Dim hProcessID As Long
Dim procHandle As Long
Dim hProcess As Long
On Local Error GoTo EXEWait_Error
hProcessID = Shell(cmdline, show)
hProcess = OpenProcess((&H100000 + &H400), True, hProcessID)
procHandle = SVR_GethWndFromProcessID(hProcessID)
If (procHandle <> 0) And (hProcess <> 0) Then
If caption_str <> "" Then
SetWindowText procHandle, caption_str
End If
Call WaitForSingleObject(hProcess, -1&)
CloseHandle hProcess
SVR_EXEWait = True
End If
EXEWait_Error:
End Function
