Как из VB определить запущен или нет Word?
Формулировка задачи:
Как из VB определить запущен или нет Word?
Решение задачи: «Как из VB определить запущен или нет Word?»
textual
Листинг программы
Public Declare Function apiGetDesktopWindow Lib 'user32' Alias 'GetDesktopWindow' () As Long
Public Declare Function apiGetWindow Lib 'user32' Alias 'GetWindow' (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function apiGetWindowLong Lib 'user32' Alias 'GetWindowLongA' (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function apiGetWindowText Lib 'user32' Alias 'GetWindowTextA' (ByVal Hwnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
Public Const mcGWCHILD = 5
Public Const mcGWHWNDNEXT = 2
Public Const mcGWLSTYLE = (-16)
Public Const mcWSVISIBLE = &H10000000
Public Const mconMAXLEN = 255
'
Public Function fEnumWindows(ByRef winArr() As String)
Dim lngx As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String
Dim n As Integer
'
ReDim winArr(1 To 1000)
n = 0
'
lngx = apiGetDesktopWindow()
'Return the first child to Desktop
lngx = apiGetWindow(lngx, mcGWCHILD)
'
Do While Not lngx = 0
strCaption = fGetCaption(lngx)
If Len(strCaption) > 0 Then
lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
'enum visible windows only
If lngStyle And mcWSVISIBLE Then
n = n + 1
winArr(n) = fGetCaption(lngx)
End If
End If
lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
Loop
'
If n > 0 Then ReDim Preserve winArr(1 To n)
fEnumWindows = n
'
End Function
'
Public Function fGetCaption(Hwnd As Long)
Dim strBuffer As String
Dim intCount As Integer
'
strBuffer = String$(mconMAXLEN - 1, 0)
intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
fGetCaption = Left$(strBuffer, intCount)
End If
End Function
'
Sub Main()
Dim i As Integer, appTitle As String
Dim winArray() As String
'
appTitle = InputBox('Введите заголовок приложения', 'Запущено ли приложение?', _
'Microsoft Word')
'
' Перечисление заголовков окон запущенных и видимых приложений (если надо):
For i = 1 To fEnumWindows(winArray)
Debug.Print winArray(i)
Next i
'
' Определение, запущено ли приложение:
If IsAppRunning(appTitle) Then
MsgBox 'Приложение ' + appTitle + ' запущено!', vbInformation, 'Информация'
Else
MsgBox 'Приложение ' + appTitle + ' не запущено.', vbInformation, 'Информация'
End If
'
End Sub
'
Public Function IsAppRunning(ByVal appWindowCaption As String) As Boolean
Dim i As Integer
Dim winArray() As String
'
IsAppRunning = False
For i = 1 To fEnumWindows(winArray)
If InStr(1, winArray(i), appWindowCaption) > 0 Then
IsAppRunning = True
End If
Next i
End Function