Hur gör jag för att stänga ett program som jag har sökvägen till?

Jag tror inte det finns något sätt att göra det på med enbart sökvägen.

Sättet jag skulle göra det på är att ta reda på Hwnd för programmets mainfönster och via API SendMessageTimeOut skicka in VM_Close
Ifall det inte funkade skulle jag köra en Kill på processen.

API funktioner att titta på är

'för Ren nerstängning
Public Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, _
ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long

'För en Kill
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId 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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long

hmm jag är extrem nybörjare men så här ser det ut nu:
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 Any) As Long

Private Const WM_CLOSE = &H10


Private Sub Command1_Click()
Shell (text1)
End Sub

Text1 är alltås sökvägen till filen, det fyller man i tidigare...

sen för att köra din kill hur skriver jag då?

I ett formulär

<code>
Option Explicit
Private RetH As Long

Private Sub Command1_Click()
RetH = Shell(SökvägenTillFilen)
RetH = GetWinHandle(RetH)
End Sub

Private Sub Command2_Click()
CloseApplication RetH
End Sub

</code>

I en modul

<code>
Option Explicit

Public Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, _
ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal Hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal Hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, _
ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult 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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long

Public Const GW_HWNDNEXT = 2
Public Const SMTO_BLOCK = &H1
Public Const WM_CLOSE = &H10
Public Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Function ProcIDFromWnd(ByVal Hwnd As Long) As Long
Dim idProc As Long

'PID för denna HWnd
GetWindowThreadProcessId Hwnd, idProc

ProcIDFromWnd = idProc
End Function

Public Function GetWinHandle(hInstance As Long) As Long
Dim tempHwnd As Long

'Fånga det första window handtaget som hittas
tempHwnd = FindWindow(vbNullString, vbNullString)

'Loopa tills en match hittas eller inga fler fönster finns
Do Until tempHwnd = 0
'Ifall det är huvudfönstret
If GetParent(tempHwnd) = 0 Then
'Kolla ifall PID är en match
If hInstance = ProcIDFromWnd(tempHwnd) Then
' Returnera det funna handtaget
GetWinHandle = tempHwnd
Exit Do
End If
End If

'Ifall handtaget inte har hittats fånga nästa...
tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
Loop
End Function

Public Sub CloseApplication(ByVal Hwnd As Long)
Dim lngReturnValue As Long
Dim lngProcess As Long
Dim lngProcessID As Long
Dim lngResult As Long

'Ren nerstängning
lngReturnValue = SendMessageTimeout(Hwnd, WM_CLOSE, 0&, 0&, SMTO_BLOCK, 5000, lngResult)

'Kill för att vara på säkra sidan
lngReturnValue = GetWindowThreadProcessId(Hwnd, lngProcessID)
lngProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, lngProcessID)
lngReturnValue = TerminateProcess(lngProcess, 0&)
End Sub

</code>

hmm fungerar inte, när ja trycker på stänga knappen händer det ingenting
gjorde exakt som du sa, enda jag ändrade var:
RetH = GetWinHandle(RetH)
från: RetH = GetWinHandle(Ret) till RetH = GetWinHandle(RetH) antar att du bara missade H där.

löste det genom att lägga till en ny variabel:
Option Explicit
Private RetH As Long
Private Reta As Long

Private Sub Command1_Click()
RetH = Shell("D:\vb\test.exe", vbNormalFocus)
Reta = GetWinHandle(RetH)
End Sub

Private Sub Command2_Click()
CloseApplication Reta
End Sub


antar att den inte gillade att det var samma namn på båda variablarna.

Hm... du har rätt i att jag glömde H´et men det konstiga är att det funkar helt ok hos mig att köra samma variabel.
Det kanske finns någon som har en förklaring till det ?
Jag kör Windows 2000...

hmm asså detta är lite sjukt, i ena mitt script som jag bara testade körde jag så som jag rättade dig. men i mitt andra kör jag det som du sade och det fungerar där.

Sen en sak till, detta fungera nu. Dock fungerar det inte på alla program. Tex winamp, det startas men stängs inte ner av funktionen, varför?

Skumt, jag kör denna kod i ett Program man använder för att bevaka program som absolut inte får gå ner, ifall de är nere eller slutar svara så , dödar det processen och sätter igång programmet igen. Jag har aldrig fått en buggrapport om att vissa program inte vill termineras. Kan du testa via Task Mangager om det går att köra en kill på Winamp ?

jovisst, hur kör jag en kill i taskmanager då?

End process eller? Det går iaf.

Japp End Process.
Lite konstigt att det fungerar i Task managern att köra en kill på WinAmp men inte mitt kodexempel, jag är inte hundra på det men det borde vara samma API anrop som
körs i bakgrunden i både min kodexempel och Task managerns End Process.

Prova att köra med returvärdet direkt från GetWindowThreadProcessId i TerminateProcess utan att gå via OpenProcess.

Om inte det funkar vet jag inte vidare hur jag ska hjälpa dig, någon annan kanske ?

Prova att köra med returvärdet direkt från GetWindowThreadProcessId i TerminateProcess utan att gå via OpenProcess.

Hur? extrem nybörjare som sagt.


btw kan de ha något att göra med att man inte kan köra flera applikationer av winamp samtidigt. hmm eller nej det borde det inte för jag har ett till program de inte fungerar på, där startas det enbart.

detta är ganska skummt asså här är koden jag har:
Option Explicit
Private RetH As Long


Private Sub sTang_Click()
CloseApplication RetH
End Sub

Private Sub start_Click()
RetH = Shell("C:\Program Files\Winamp\winamp.exe")
RetH = GetWinHandle(RetH)
End Sub


sen använder jag koden jag fick av dig i modulen. nu har jag märkt att nästan inga lite mer proffsiga program, typ winamp, internet explore osv går att stänga ner.
Det går att startas men inte stängas. Varför?

Public Sub CloseApplication(ByVal Hwnd As Long)
Dim lngReturnValue As Long
Dim lngProcessID As Long
'Ren nerstängning
lngReturnValue = GetWindowThreadProcessId(Hwnd, lngProcessID)

End Sub
gjort så för att göra en ren kill, inget bättre resultat.

vet inte om den här koden löser problemet men det minskar iaf felkällor :)
Vad kör du för operativsystem? Jag kör samma OS som knoton så det funkade bra för mig.


<code>
Option Explicit
Private RetArray(100) As Long
Private RetH As Long

Private Sub Command1_Click()
RetArray(RetH) = Shell("C:\Program Files\Winamp\winamp.exe")
RetArray(RetH) = GetWinHandle(RetArray(RetH))
If RetArray(RetH) <> 0 Then RetH = RetH + 1
End Sub

Private Sub Command2_Click()
Dim x&
For x = 0 To 100
If RetArray(x) = 0 Then Exit Sub
CloseApplication RetArray(x)
Next x
End Sub

</code>

jag kör XP på datorn jag kodar på , på datorn jag tänkte köra programmet kör jag windows 2003 server

Herman - Har du lust att förklara vad du har gjort ? :-)

Joakim jag tror det kan vara så här att exe filen du startar returnerar inte pid för huvudprocessen/fönstret. På något vis så startar exe filen en till process som är själva huvudprocessen.

Löste det nästan med hjälp av denna sida:
http://trixar.com/~makai/findclose.htm
Dock när det stängs ner kommer det upp att man måste bekräfta nerstägning. Det är ju så i vissa program, går detta att komma förbi? testade från taskmanager och där kom bekräftning upp också :/

Ok, det var inte så konstigt egentligen, processen som försökte köra en kill på en annan process hade inte de privilegier för att göra det. Jag hittade ett exempel du
kan testa med.

<code>
Option Explicit

Private Type LUID
lowpart As Long
highpart As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle _
As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal _
TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
PreviousState As Any, ReturnLength As Any) 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 TerminateProcess Lib "kernel32" (ByVal hProcess As _
Long, ByVal uExitCode As Long) As Long

Private myPid As Long

' Terminate any application and return an exit code to Windows
' This works under NT/2000, even when the calling process
' doesn't have the privilege to terminate the application
' (for example, this may happen when the process was launched
' by yet another program)
'
' Usage: Dim pID As Long
' pID = Shell("Notepad.Exe", vbNormalFocus)
' '...
' If KillProcess(pID, 0) Then
' MsgBox "Notepad was terminated"
' End If

Function KillProcess(ByVal hProcessID As Long, Optional ByVal ExitCode As Long) _
As Boolean
Dim hToken As Long
Dim hProcess As Long
Dim tp As TOKEN_PRIVILEGES

' Windows NT/2000 require a special treatment
' to ensure that the calling process has the
' privileges to shut down the system

' under NT the high-order bit (that is, the sign bit)
' of the value retured by GetVersion is cleared
If GetVersion() >= 0 Then
' open the tokens for the current process
' exit if any error
If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY, hToken) = 0 Then
GoTo CleanUp
End If

' retrieves the locally unique identifier (LUID) used
' to locally represent the specified privilege name
' (first argument = "" means the local system)
' Exit if any error
If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then
GoTo CleanUp
End If

' complete the TOKEN_PRIVILEGES structure with the # of
' privileges and the desired attribute
tp.PrivilegeCount = 1
tp.Attributes = SE_PRIVILEGE_ENABLED

' try to acquire debug privilege for this process
' exit if error
If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, _
ByVal 0&) = 0 Then
GoTo CleanUp
End If
End If

' now we can finally open the other process
' while having complete access on its attributes
' exit if any error
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
If hProcess Then
' call was successful, so we can kill the application
' set return value for this function
KillProcess = (TerminateProcess(hProcess, ExitCode) <> 0)
' close the process handle
CloseHandle hProcess
End If

If GetVersion() >= 0 Then
' under NT restore original privileges
tp.Attributes = 0
AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&

CleanUp:
If hToken Then CloseHandle hToken
End If
End Function


Private Sub Command1_Click()
myPid = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE", vbNormalFocus)
End Sub

Private Sub Command2_Click()
KillProcess myPid
End Sub

</code>

Shell returner 0 om den misslyckas att skapa en process

jag gjorde så att dom processerna man startar läggs i en array. Och sedan när jag ska stänga programmet/programmen så går den igenom arrayen och stänger alla processer.


om jag skriver Shell("C:\Program Files\Winamp\winamp.exe") då öppnas winamp minimerat och då är det lockande att trycka på knappen igen. Då blir det fel när man ska stänga den.
Winamp öppnar bara en instans men om det öppnas flera så känner den av det också och stänger alla.

Men som sagt bara för att minska felkällorna :)

denna kode fungerade utmärk, ska ha den i programmet istället. Tackar!

nu ska jag vell endå kunna sätta denna tråd som löst?

Joakim - Jag tycker du ska blanda de olika koderna, man ska alltid sträva efter att göra en clean shutdown innan man dödar processen. Att döda en process ska enbart
vara en sista utväg.