Newsgroup: it.comp.lang.visual-basic
Titolo: kill applicazione attiva

Ho pescato nel database del sito nonchè su google due codici per il kill di
un'applicazione attiva, ma nessuno dei due ha funzionato.
aaa ha scritto in un post di essere riuscito, gli ho chiesto come ha fatto,
ma non ha risposto.
Qualcuno oppure aaa stesso mi sa dire come si fa?
Grazie mille
Peppe
peppe26 chiocciola tele2 punto it

> Qualcuno oppure aaa stesso mi sa dire come si fa?
Si scusami sono stato distante dal pc. Allora ti posto il codice.. In
pratica il codice cerca nel taskmanager il processo che gli passi, cicla o
ogni volta che lo trova lo killa... A me può capitare che dopo il primo
avvio l'applicazione possa essere avviata altre 2 volte quindi ho bisogno di
ciclare x chiuderle tutte. Tu puoi anche uscire dal ciclo appena trovi il
processo che devi killare. Siccome il modulo fa anche altre cose nella zona
delle dichiarazioni potrebbero non servirti. (anzi se facendo pulizia mi
dici che dichiarazioni hai tolto mi fai un favore).
'Nel Modulo
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 Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal
lFlags _
    As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As
Long, _
    uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As
Long, _
    uProcess As PROCESSENTRY32) As Long
Public arr() As Variant
Public ProcessiNumber As Long
'****************** Inizio Codice Funzioni ********************************
Public Function KillProcessobyNome(NomeFile As String) As Boolean
    Dim hSnapshot As Long
    Dim procEntry As PROCESSENTRY32
    Dim res As Long
    Dim index As Integer
    KillProcessobyNome = False
    ' take a snapshot of all active processes
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    ' raise error if fails (for example under WinNT)
    If hSnapshot = -1 Then Err.Raise 999, , "Unable to get process snapshot"
    ' prepare the receiving buffer
    procEntry.dwSize = Len(procEntry)
    ' prepare a result array
    ReDim arr(5, 100) As Variant
    ' start with the first process
    res = Process32First(hSnapshot, procEntry)
    Do While res
        If LCase(Left$(procEntry.szExeFile, InStr(procEntry.szExeFile & _
            vbNullChar, vbNullChar) - 1)) = LCase(NomeFile) Then
            If index > UBound(arr) Then
                ReDim Preserve arr(5, index + 99) As Variant
            End If
            ' store information in array
            arr(0, index) = procEntry.th32ProcessID
            KillProcess arr(0, index)
            KillProcessobyNome = True
            Exit Do
        End If
        res = Process32Next(hSnapshot, procEntry)
        index = index + 1
    Loop
    ' close the snapshot
    CloseHandle hSnapshot
    ProcessiNumber = CLng(index)
    ' return the result
    ReDim Preserve arr(5, index - 1) As Variant
End Function
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
Ciao e buon lavoro.

 Qualcuno oppure aaa stesso mi sa dire come si fa?
Prima prova a scaricarti API_GUIDE da qui ..
http://www.allapi.net/cgi-bin/redirect.cgi?place=apiguide
vedo solo questo post e non so cosa hai provato in precedenza
cerca "WMI"  su gooooooogggggle
oppure prendi quello che ti serve uno di  questi 2 :
'The TerminateProcess function is used to unconditionally cause a
'process to exit. Use it only in extreme circumstances. The state of
'global data maintained by dynamic-link libraries (DLLs) may be
'compromised if TerminateProcess is used rather than ExitProcess
'Sending a WM_CLOSE message is definitely the preferred method
'Tom Esch
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal _
 hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
 (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas _
 As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long,  _
ByVal uExitCode As Long) As Long
Private Sub Form_Load()
Dim hwnd As Long, PID As Long, hProc As Long
'hwnd = FindWindow("Notepad", vbNullString)
'hwnd = FindWindow("Outlook Express Browser Class", vbNullString)
hwnd = FindWindow("IEFrame", vbNullString)
If hwnd <> 0 Then
GetWindowThreadProcessId hwnd, PID
MsgBox PID
hProc = OpenProcess(PROCESS_TERMINATE, 0, PID)
If hProc <> 0 Then
TerminateProcess hProc, 0
CloseHandle hProc
End If
End If
End Sub
2 :
API: Close another Application
 Author(s)
Dev Ashish
  To close another app, you need to know it's ClassName.   If you don't, then
 pick up the code from the article "Find
ClassName of a Running App".  Then pass the classname as an
 argument to this function.
  Thanks to Dimitri Furman for pointing out the incorrect use of
WaitForSingleObject API in the old sample.
'************** Code Start ***************
' Code Courtesy of
' Dev Ashish
'
Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF
Private Declare Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long
Private Declare Function apiFindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
    As Long
Private Declare Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
Private Declare Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal hWnd As Long) _
    As Long
Private Declare Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal hWnd As Long, _
    lpdwProcessID As Long) _
    As Long
Function fCloseApp(lpClassName As String) As Boolean
'Usage Examples:
'   To close Calculator:
'       ?fCloseApp("SciCalc")
'
Dim lngRet As Long, hWnd As Long, pID As Long
    hWnd = apiFindWindow(lpClassName, vbNullString)
    If (hWnd) Then
        lngRet = apiPostMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(hWnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(hWnd) = 0)
    End If
End Function
'************* Code End ***************
--
Fosco