Close application

fx.
Private Sub Yes_Click()
Shell \"NOTEPAD.EXE \", vbNormalFocus
Unload Me
End Sub

?

//>Rune

Unload Me lukker din egen applikation ;-)

lol det var det jeg trode du ville ha' :-D

Hmm 2 sek.. jeg kigger lige på det igen nu hvor jeg har læst dit spm :-D

//>Rune

Lytter med og måske nogen kan svare på : Kan man forresten gøre det i Delphi ?

Jeg fandt en løsning på microsoft.com - men der er dog det problem at den benytter sig af et programs classname og hvordan finder man det hvis det f.eks. er et program som notepad eller et helt tredje ???? Se nederst i koden.

Private Declare Function FindWindow _
      Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, _
      ByVal lpWindowName As String) _
      As Long

Private Declare Function SendMessage _
      Lib "user32" Alias "SendMessageA" _
      (ByVal hwnd As Long, _
      ByVal wMsg As Long, _
      ByVal wParam As Long, _
      lParam As Long) _
      As Long


      Private Sub Command1_Click()
        Shell "Calc.exe", vbNormalFocus
      End Sub

      Private Sub Command2_Click()
        Dim lpClassName As String
        Dim lpCaption As String
        Dim Handle As Long

        Const NILL = 0&
        Const WM_SYSCOMMAND = &H112
        Const SC_CLOSE = &HF060&

        lpClassName = "SciCalc" 'HER ANGIVES KLASSENAVNET
        lpCaption = "Calculator"

      '* Determine the handle to the Calculator window.
        Handle = FindWindow(lpClassName$, lpCaption$)

      '* Post a message to Calc to end its existence.
        Handle = SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, NILL)

      End Sub

Ok - fandt en løsning på mit problem. Man kan anvende Spy.Exe der følger med Visual Studie C++. Denne spy kan aflæse et programs classnames.

Du kan selvfølgelig kalde

AppActivate "Untitled - Notepad"
SendKeys "+({ALT}{F4})"

Or something
The Ungod (10:43 PM) :
Men du kunne gøre flg.:

Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
   
    lpIDList As String
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

Private Declare Function ShellExecuteEx Lib "shell32" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Boolean
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, Byval uExitCode As Long) As Boolean

Sub Main ()
    Dim handle As Long
    Dim ExecInfo As SHELLEXECUTEINFO
    ExecInfo.cbSize = Len(ExecInfo)
    ExecInfo.fMask = 0
    ExecInfo.lpVerb = "open" & Chr(0)
    ExecInfo.lpFile = "notepad.exe" & Chr(0)
    ExecInfo.lpParameters = vbNullString
    ExecInfo.lpDirectory = "C:\WINDOWS" & Chr(0)
    ExecInfo.nShow = 1
    If ShellExecuteEx(ExecInfo) Then
        MsgBox "Luk notepad nu?"
        TerminateProcess ExecInfo.hProcess, 0
    End If
End Sub


Det er een mulighed, men det er ikke sikkert at det virker og hvis det gør, så bliver notepad altså ikke lukket korrekt, men force-lukket!

//>Rune

Det virker desværre ikke... og det gør mit eksempel heller ikke rigtigt. Programmet vil gerne lukke ned - men hvis programmet ligger i din Tray så lukker det altså ikke ned... så hvis du har flere forslag til hvordan man kan lukke programmer - også dem der befinder sig i ens Tray - så er jeg meget lydhør.

Har jeg desvære ikke :-(

//>Rune

Du kan bede programmet pænt om at lukke :
X = SendMessage(aHandle, WM_CLOSE, 0, 0)

Private Const WM_CLOSE = &H10
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Hvor aHandle er windows handle (svarende til Form1.hWnd property)

Hvis dette ikke virker kan du lukke programmet med vold :

  Dim hProcess As Long
  hProcess = OpenProcess(PROCESS_TERMINATE + SYNCHRONIZE, 1&, ProcessID)
  X = TerminateProcess(hProcess, 0&)
  X = CloseHandle(hProcess)

Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_TERMINATE = &H1
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

michaelemanuel >> Du skriver "Hvor aHandle er windows handle (svarende til Form1.hWnd property)" Den er jeg ikke helt med på - hvis vi antager at det er Notpad.exe jeg vil lukke - hvordan finder jeg dennes handle ??

Der er forskellige metoder til at skaffe Handle.

1) Hvis du selv starter programmet (og du bruger API CreateProcess, ikke VB's Shell) så har du direkte adgang til dit handle (PROCESS_INFORMATION indeholder både hProcess og hThread)

2) Hvis det er et kørende program du ikke selv har startet, så kan du bruge API GetWindow, den returnerer det handle du har brug for.

Dvs. at hvis jeg starter mit program via VB's Shell så har jeg ikke direkte adgang til hProcess og hThread.

Nu er jeg ikke så hård til VB - har du mulighed for at komme med et eksempel. På forhånd tak ;-)

Her er et par procedurer der kan hjælpe dig :-)

'--- isRunning ---
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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
'--- CloseApp ---
Private Const WM_CLOSE = &H10
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_TERMINATE = &H1
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'--- SyncShell ---
Private Type STARTUPINFO
  cb              As Long
  lpReserved      As String
  lpDesktop      As String
  lpTitle        As String
  dwX            As Long
  dwY            As Long
  dwXSize        As Long
  dwYSize        As Long
  dwXCountChars  As Long
  dwYCountChars  As Long
  dwFillAttribute As Long
  dwFlags        As Long
  wShowWindow    As Integer
  cbReserved2    As Integer
  lpReserved2    As Long
  hStdInput      As Long
  hStdOutput      As Long
  hStdError      As Long
End Type

Private Type PROCESS_INFORMATION
  hProcess    As Long
  hThread    As Long
  dwProcessID As Long
  dwThreadID  As Long
End Type

Private Const NORMAL_PRIORITY_CLASS      As Long = &H20&
Private Const INFINITE                  As Long = -1&
Private Const STATUS_WAIT_0              As Long = &H0
Private Const STATUS_ABANDONED_WAIT_0    As Long = &H80
Private Const STATUS_USER_APC            As Long = &HC0
Private Const STATUS_TIMEOUT            As Long = &H102
Private Const STATUS_PENDING            As Long = &H103
Private Const WAIT_FAILED                As Long = &HFFFFFFFF
Private Const WAIT_OBJECT_0              As Long = STATUS_WAIT_0
Private Const WAIT_TIMEOUT              As Long = STATUS_TIMEOUT
Private Const WAIT_ABANDONED            As Long = STATUS_ABANDONED_WAIT_0
Private Const WAIT_ABANDONED_0          As Long = STATUS_ABANDONED_WAIT_0
Private Const WAIT_IO_COMPLETION        As Long = STATUS_USER_APC
Private Const STILL_ACTIVE              As Long = STATUS_PENDING
Private Const PROCESS_QUERY_INFORMATION  As Long = &H400
Private Const STANDARD_RIGHTS_REQUIRED  As Long = &HF0000

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function InputIdle Lib "user32" Alias "WaitForInputIdle" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Public Function CloseApp(ByVal AppTitle As String, ByVal YourhWnd As Long, Optional ProcessID As Long = 0) As Integer
'---------------
' CloseApp will close AppTitle as cleanly as possible
' YourhWnd is YOUR window`s handle (This class does not have a handle to start enumeration from)
' ProcessID is AppTitle`s ProcessID (returned by VB`s Shell command)
' Return Values:
'  0 = App shut down cleanly
'  1 = App has been terminated
'  2 = App is not running
'  3 = App could not be terminated
'---------------
  '-------------
  ' Get handle to AppTitle`s window
  '-------------
  Dim aHandle As Long: aHandle = isRunning(AppTitle, YourhWnd)
  If aHandle = 0 Then CloseApp = 2: Exit Function '2 = App is not running
 
  '-------------
  ' Kindly ask AppTitle to shut down
  '-------------
  Dim X As Long
  X = IsWindow(aHandle)
  'X = PostMessage(aHandle, WM_CLOSE, 0, 0)
  X = SendMessage(aHandle, WM_CLOSE, 0, 0)
 
  '-------------
  ' Wait to see if App perform shut down
  '-------------
  Dim aSec As Integer: Dim Sec2Go As Integer: Sec2Go = 5
  Do
    DoEvents: X = IsWindow(aHandle)
    If Second(Now) <> aSec Then aSec = Second(Now): Sec2Go = Sec2Go - 1
  Loop Until (X = False) Or (Sec2Go = 0)
  If X = False Then CloseApp = 0: Exit Function '0 = App shut down cleanly
 
  '-------------
  ' Create a ProcessHandle
  '-------------
  Dim hProcess As Long
  If ProcessID = 0 Then CloseApp = 3: Exit Function '3 = App could not be terminated
  hProcess = OpenProcess(PROCESS_TERMINATE + SYNCHRONIZE, 1&, ProcessID)
  If hProcess = 0 Then CloseApp = 3: Exit Function '3 = App could not be terminated
 
  '-------------
  ' Terminate Process
  '-------------
  X = TerminateProcess(hProcess, 0&)
  If X = False Then CloseApp = 3: Exit Function '3 = App could not be terminated
  X = CloseHandle(hProcess)
  CloseApp = 1 '1 = App has been terminated
End Function

Public Function isRunning(ByVal AppTitle As String, ByVal hwnd As Long) As Long
  Dim TaskList As String: Dim ListItem As String * 100: Dim Lenght As Long
  CurrWnd = GetWindow(hwnd, GW_HWNDFIRST): NoOfhWnd = 0
  Do While CurrWnd <> 0
    Lenght = GetWindowText(CurrWnd, ListItem, 100)
    If Lenght > 0 Then
      TaskList = Left$(ListItem, Lenght)
      If Left$(TaskList, Len(AppTitle)) = AppTitle Then isRunning = CurrWnd: Exit Function
    End If
    CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
    DoEvents
  Loop
  isRunning = 0
End Function

Public Function SyncShell(CommandLine As String, ByVal WaitForTermination As Boolean, Optional Timeout As Long = INFINITE) As Boolean
'---------------
' WaitForTermination: True =Wait until App has terminated,
'                    False=Return when App is running.
' TimeOut: Return after these milliseconds even though above condition isn't meet
' Return Value:
'  True = OK
'  False= TimeOut or Error
'---------------
  Dim proc As PROCESS_INFORMATION
  Dim Start As STARTUPINFO
  Dim ret As Long
  Dim nMilliseconds As Long
  If Timeout > 0 Then nMilliseconds = Timeout Else nMilliseconds = INFINITE

  '--- Initialize the STARTUPINFO structure and Start the shelled application ---
  Start.cb = Len(Start)
  Call CreateProcessA(0&, CommandLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, proc)

  If WaitForTermination Then
    '--- Wait for the shelled application to terminate ---
    ret = WaitForSingleObject(proc.hProcess, nMilliseconds)
  Else
    '--- Wait for the shelled application to finish setting up its UI ---
    ret = InputIdle(proc.hProcess, nMilliseconds)
  End If

  Call CloseHandle(proc.hProcess)

  '--- Return True if the application finished. Otherwise it timed out or gave an error ---
  SyncShell = (ret = WAIT_OBJECT_0)
End Function

Det forvirre vist lidt mere end det gavner er jeg bange for ;-)

Hvis jeg må vise dig min nuværende kode og hvis ud har mulighed for at hjælpe mig implementere application close proces. jeg har envidere forhøjet point satsen da det tilsyneladende er svære for mig at implementere.

På forhånd tak.


'Nedenstående kode er et eksempel fra microsoft.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Const cNULL = 0&
Const cSYSCOMMAND = &H112
Const cCLOSE = &HF060&

'Starter en applikation via shell
'Jeg kalder aVarExePath som er stien til applikationen
Public Function Start_Application(ByVal aVarExePath As Variant)
 
    Shell aVarExePath, vbNormalFocus

End Function

'Lukker ned for applikationen - men på nuværende tidspunkt kan den kun lukke ned for
'de applikationer der findes i proceslinien.
'aStrClassName er applikationens classname
'aStrCaption er applikationens titel.
Public Function End_Application(ByVal aStrClassName As String, ByVal aStrCaption As String)

    Dim aLngHandle As Long

    aLngHandle = FindWindow(aStrClassName$, aStrCaption$)
       
    aLngHandle = SendMessage(aLngHandle, cSYSCOMMAND, cCLOSE, cNULL)
   
End Function

'Denne funktion chekker om applikationen er åben.
Public Function Exist_Application(ByVal aStrClassName As String, ByVal aStrCaption As String)

    Exist_Application = FindWindow(aStrClassName$, aStrCaption$)
       
End Function

Din kode fungerer i princippet OK.
Der hvor jeg tror det går galt for dig er valg af Caption string.

Hvis du starter f.eks. "Notepad.exe" med Shell, så er den Caption string du skal benytte "Untitled - Notepad" og ikke navnet på .exe filen.

Hvis blot den korrekte Caption angives, så lukker programmet fint.

Det er korrket. Men problemet er ikke at notepad ikke vil lukke ned men derimod vil et program der ligger og køre i baggrunden (i f.eks. systray) ikke lukke ned fordi denne ikke har en caption.

F.eks. hvis ICQ eller MS Messenger vil ikke lukke ned hvis de ligger i systray.

Er jeg forkert på den eller ?

Tja, du blander tingene lidt sammen.

Du starter en Process.
Denne Process har een eller flere Threads.
Endvidere kan den oprette ingen eller flere Windows.

Hvis et program (en Process og en Thread) ikke opretter et Window (grafisk brugerflade - ligesom en Form), så kan du ikke lukke dette Window med SendMessage.

I dette tilfælde skal du standse Procesen (og dermed standses også alle Threads og evt. Windows) med API TerminateProcess.

Så Ja, hvis et program ikke har et Window, så kan du ikke lukke det med SendMessage men må benytte TerminateProcess.

Håber at ovenstående besvarer dine spørgsmål.

Jeg kan godt anvende TerminateProcess i forbindelse med at jeg starter min process op i VB's Shell - eller skal jeg anvende CreateProcess ?

Som sagt returnerer VB's Shell en ProcessID.

Som vist i tidligere reply kan du ud fra ProcessID bruge API OpenProcess og TerminateProcess til at lukke et program (Se CloseApp funktionen i tidligere reply).

Så fik jeg det langt om længe til at virke og her er resultatet til dem der måtte være intresseret. Tak for hjælpen medions og michaelemanuel.

Private Declare Function OpenProcess Lib "kernel32" _
  (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
  ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
  (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" _
  (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 

Public Function Start_Application(ByVal aVarExePath As Variant) As Long
 
    Start_Application = Shell(aVarExePath, vbNormalFocus)

End Function


Public Function End_Application(ByVal aLngShellProcessID As Long) As Long

    hProcess = OpenProcess(&H1F0FFF, 0&, aLngShellProcessID)
   
    If hProcess <> 0 Then

        GetExitCodeProcess hProcess, lExitCode
       
        If lExitCode <> 0 Then
 
            End_Application = TerminateProcess(hProcess, lExitCode)
           
        End If
       
    End If

End Function

Thx 4 Poinz

//>Rune