Avatar billede sunep Nybegynder
15. juni 2002 - 17:55 Der er 6 kommentarer og
1 løsning

Tjek om program kører

Kan der via Visual Basic tjekkes om et eksternt program kører. altså et andet program end ens eget. og det er ikke en service jeg snakker om.
Avatar billede sjh Nybegynder
15. juni 2002 - 18:13 #1
'------------------------------ Module1 ------------------------------
Option Explicit

Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long)
Declare Function GetParent& Lib "user32" (ByVal hwnd As Long)
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Dim sPattern As String, hFind As Long

Private Function FindActivateTitle(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim k As Long, sName As String
    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 lParam = 0 Then sName = UCase(sName)
            If sName Like sPattern Then
                hFind = hwnd
FindActivateTitle = 0
    Exit Function
End If
End If
End If
FindActivateTitle = 1
End Function

Public Function Window_FindA(sTitle As String, Optional sMatchCase As Boolean = True) As Long
sPattern = sTitle: hFind = 0
If Not sMatchCase Then sPattern = UCase(sPattern)
EnumWindows AddressOf FindActivateTitle, sMatchCase
Window_FindA = hFind
End Function
'------------------------------ Module1 ------------------------------


'------------------------------ Form1 ------------------------------
Option Explicit

Private Sub Command1_Click()
  If Window_FindA("*winamp*", False) Then
    MsgBox "winamp kørere"
      Else
    MsgBox "winamp kørere ikke"
  End If
End Sub
'------------------------------ Form1 ------------------------------
Avatar billede sunep Nybegynder
15. juni 2002 - 18:25 #2
Jeg skal nok få tjekket det. men jeg tænkte på om du ville indsætte nogen i kommentarer i koden så jeg kan forstå den. så ville jeg blive kanon glad
Avatar billede sjh Nybegynder
15. juni 2002 - 18:26 #3
disse 3 kan du godt fjærne:

'------------------------------ Module1 ------------------------------
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
'------------------------------ Module1 ------------------------------
Avatar billede joern Nybegynder
15. juni 2002 - 21:13 #4
Jeg har lavet en VB-tasklist engang.

I et modul:  (formen nedenfor)

Option Explicit

      ' API Constants
      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

      ' The following constants will be combined to define properties
      ' of a 'normal' task top-level window. Any window with ' these set will be
      ' included in the list:
      Const WS_VISIBLE = &H10000000 ' Window is not hidden
      Const WS_BORDER = &H800000 ' Window has a border
      ' Other bits that are normally set include:
      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


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

        'Structure filled by FillTaskList Sub call
        Public TaskList(1000) As TASK_STRUCT
        Public NumTasks As Long

        ' Returns if a Process is a Visible Window
        Public Function IsTask(hwndTask As Long) As Boolean
            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

        ' Fills the Task structure with captions and hWnd of all active programs
        Public Sub FillTaskList(hWnd As Long)
            Dim hwndTask As Long
            Dim intLen As Long
            Dim strTitle As String
            Dim cnt As Integer

            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 And IsTask(hwndTask) 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
                        TaskList(cnt).TaskName = strTitle
                        TaskList(cnt).TaskID = hwndTask
                        cnt = cnt + 1
                    End If
                End If
                hwndTask = GetWindow(hwndTask, GW_HWNDNEXT)
            Loop
            NumTasks = cnt
        End Sub

        ' 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
------------------------------------------
formen:
Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub cmdRefresh_Click()

    Dim i As Integer
    ' Clear the ListBox
    lstapp.Clear
    ' Fills the Task List Structure
    FillTaskList Me.hWnd
    ' Add items into the ListBox
    For i = 0 To NumTasks - 1
      lstapp.AddItem TaskList(i).TaskName
      lstapp.ItemData(lstapp.NewIndex) = TaskList(i).TaskID
    Next
End Sub
Private Sub cmdSwitch_Click()
  Dim hWnd As Long
  If lstapp.ListIndex < 0 Then Beep: Exit Sub
  ' Get window handle from listbox array
  hWnd = lstapp.ItemData(lstapp.ListIndex)
  ' Switch to the selected Task
  SwitchTo hWnd
End Sub
Private Sub Form_Load()
'Make a form with 3 Command buttons: cmdExit, cmdRefresh and cmdSwitch. Add a ListBox named lstApp.
        'Place the following code in Form1 code window:
  cmdrefresh.Value = True
End Sub


Private Sub lstapp_DblClick()
cmdSwitch.Value = True
End Sub

Jeg zipper gerne projektet til dig.

M.v.h.  Jørn
Avatar billede sunep Nybegynder
15. juni 2002 - 21:47 #5
Den virker lige som jeg vil have det
Avatar billede bodekaer Nybegynder
04. oktober 2002 - 10:41 #6
sjh: kan man også tjekke om en service kører med det script?

Jeg har et program som skal tjekke om et andet program kører, men jeg har kun programmets hWnd, (og ikke titel som f.eks. "winamp")

Hvordan tjekker jeg så om det hWnd eksisterer?
Avatar billede bodekaer Nybegynder
04. oktober 2002 - 10:49 #7
Lige meget, jeg legede lidt med din kode og lavede følgende:

Private Function FindActivateTitle(ByVal hwnd As Long) As Long
    Dim k As Long, sName As String
    If hwnd = lngFindHwnd Then
        hFind = hwnd
        FindActivateTitle = 0
        Exit Function
    End If
    FindActivateTitle = 1
End Function

Public Function Window_FindA(findHwnd As Long) As Long
    lngFindHwnd = findHwnd
    hFind = 0
    EnumWindows AddressOf FindActivateTitle, 0
    Window_FindA = hFind
End Function


Det fungerer vist uden problemer
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester