Newsgroup: it.comp.lang.visual-basic
Titolo: Chiudere un'applicazione VB attiva da codice

Ho due applicazioni: applicazione A e applicazione B, entrambe in VB.
L'applicazione A viene lanciata all'avvio di Windows nell'esecuzione
automatica, mentre l'applicazione B, costituisce il mio ambiente di lavoro.
Dall'applicazione B ho la necessità di chiudere l'applicazione A.
Come faccio?


l'applicazione A scrive nel registro (o in un file) l'hWnd della finestra
principale del programma, mentre B legge il valore e utilizza SendMessage()
con WM_CLOSE per chiuderla
Ciao
Faber

> SIN:

A titolo di pura e semplice curiosita` ti propongo una soluzione vecchio
stile basata su DDE:
' Proget1
' Form1 (VB.Form)
'
Option Explicit
Private Sub Form_LinkExecute( _
  ByRef CmdStr As String _
, ByRef Cancel As Integer _
)
  Select Case CmdStr
  Case "[Quit]"
    MsgBox "Bye"
    Unload Me
  Case Else
    Cancel = True
  End Select
End Sub
Private Sub Form_Load( _
)
  ' LinkMode = 1 - Source
End Sub
' Proget2
' Form1 (VB.Form)
' Label1 (VB.Label)
' Command1 (VB.CommandButton)
'
Option Explicit
Private Const mc_strDDEApp      As String = "Proget1"
Private Const mc_strDDEArg      As String = "Form1"
Private Const mc_strDDECmdQuit  As String = "[Quit]"
Private Sub Command1_Click( _
)
  Label1.Caption = mc_strDDECmdQuit
End Sub
Private Sub Form_Load( _
)
  Label1.Caption = ""
End Sub
Private Sub Label1_Change( _
)
  On Error GoTo Err
  Dim strCmd As String
  strCmd = Label1.Caption
  If Len(strCmd) Then
    With Label1
      .LinkTopic = mc_strDDEApp & "|" & mc_strDDEArg
      .LinkMode = vbLinkManual
      .LinkExecute strCmd
    End With
    Label1.Caption = ""
  Else
    Label1.LinkMode = vbLinkNone
  End If
  Exit Sub
Err: MsgBox Err.Description
End Sub
--
Ciao.
Maurizio
--------
?SPQR(C)
 X
--------


E se il programma che devo chiudere è Internet Explorer?
So che con SendMessage() non funziona: hai una soluzione?
Grazie
Ciao
Axel

 So che con SendMessage() non funziona: hai una soluzione?
non mi risulta che non funziona...
Faber

 ha scritto nel messaggio
news:RoAD6.37500$r67.8...@news2.tin.it...

Penso di avere la soluzione definitiva. Prima di tutto ti serve conoscere il
nome dell'eseguibile che vuoi chiudere, quindi ottenere il suo AppID, e
infine devi scegliere se terminarla in modo brutale o inviargli un messaggio
per chiuderla.
Io posso darti il codice di alcuni moduli che consentono di:
1) ottenere una lista del tipo Scripting.Dictionary (il riferimento è
scrrun.dll)
contenente i nomi e gli AppID di tutti i processi in esecuzione al momento
della chiamata
2) terminare un processo dato il suo AppID nello stesso modo in cui
verrebbe terminato da CTRL+ALT+CANC -> Termina operazione.
Per inviare il messaggio WM_CLOSE non ci sono ancora arrivato, ma
ci sono un paio di funzioni che consentono di ottenere l'HWND della
finestra principale dato l'AppID.
Ok, basta chiacchiere. Passiamo alle cose serie. Le procedure funzionano
indifferentemente su Win9x/Millenium/WinNT/2000. Ogni sezione può
essere salvata come modulo.
--------------------------------------------------- VERSIONE DELLA
PIATTAFORMA
Option Explicit
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation
As OSVERSIONINFO) As Integer
Public Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long           '1 = Windows 95/98 --- 2 = Windows NT
   szCSDVersion As String * 128
End Type
Public Function getVersion() As Long
'Questa funzione restituisce 1 se il sistema operativo è Win95/Win98/WinME
'2 se si tratta invece di WinNT/Win2000.
'Questo perchè per ottenere la lista dei processi le due tecnologie sono
'estremamente diverse.
   Dim osinfo As OSVERSIONINFO
   Dim retvalue As Integer
   osinfo.dwOSVersionInfoSize = 148
   osinfo.szCSDVersion = Space$(128)
   retvalue = GetVersionExA(osinfo)
   getVersion = osinfo.dwPlatformId
End Function
--------------------------------------------------- LISTA DEI PROCESSI
ATTIVI
Option Explicit
'Anche se i link alle librerie sono diversi, è possibile compilare
'questo modulo in un solo eseguibile
'Queste due per Win9x/Millenium
Public Declare Function Process32First Lib "kernel32"_
            (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32"_
            (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
'Queste altre per WinNT/2000
Public Declare Function CloseHandle Lib "Kernel32.dll" _
      (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" _
      (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal
dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" _
      (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long)
As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
     (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As
String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" _
    (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long,
ByRef cbNeeded As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
    (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Type PROCESSENTRY32
   dwSize As Long
   cntUsage As Long
   th32ProcessID As Long           'Questo processo
   th32DefaultHeapID As Long
   th32ModuleID As Long            'Eseguibile associato
   cntThreads As Long
   th32ParentProcessID As Long     'Processo padre di questo processo
   pcPriClassBase As Long          'Priorità base del thread del processo
   dwFlags As Long
   szExeFile As String * 260       'MAX_PATH
End Type
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Function StrZToStr(s As String) As String
   StrZToStr = Left$(s, Len(s) - 1)
End Function
Public Sub GetProcessList(ProcessList as Scripting.Dictionary)
'ATTENZIONE!!! Prima di usare questa procedura si prega di allocare
'uno Scripting.Dictionary da passare ByRef.
   ProcessList.RemoveAll
   Select Case getVersion()
   Case 1 'Windows 95/98/WinME
      Dim f As Long, sname As String, prid As String
      Dim hSnap As Long, proc As PROCESSENTRY32
      hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
      If hSnap = hNull Then Exit Sub
      proc.dwSize = Len(proc)
      'Iteriamo attraverso lo snapshot dei processi
      f = Process32First(hSnap, proc)
      Do While f
         sname = StrZToStr(proc.szExeFile)
         prid = proc.th32ProcessID
         ProcessList.Add prid, sname
         f = Process32Next(hSnap, proc)
      Loop
   Case 2 'Windows NT/2000
      Dim cb As Long
      Dim cbNeeded As Long
      Dim NumElements As Long
      Dim ProcessIDs() As Long
      Dim cbNeeded2 As Long
      Dim NumElements2 As Long
      Dim Modules(1 To 200) As Long
      Dim lRet As Long
      Dim ModuleName As String
      Dim nSize As Long
      Dim hProcess As Long
      Dim i As Long
      'Otteniamo l'array contenente i ProcessId di ogni processo
      cb = 8
      cbNeeded = 96
      Do While cb <= cbNeeded
         cb = cb * 2
         ReDim ProcessIDs(cb / 4) As Long
         lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
      Loop
      NumElements = cbNeeded / 4
      For i = 1 To NumElements
         'Otteniamo un handle al processo
         hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or
PROCESS_VM_READ, 0, ProcessIDs(i))
         'Siamo riusciti a ottenere l'handle
         If hProcess <> 0 Then
            'Otteniamo un array di handle ai moduli per il processo
specificato
            lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded2)
            'Se siamo riusciti a ottenere l'array dei moduli, otteniamo
ModuleFileName
            If lRet <> 0 Then
               ModuleName = Space(MAX_PATH)
               nSize = 500
               lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName,
nSize)
               ProcessList.Add Trim(Str(ProcessIDs(i))), Left(ModuleName,
lRet)
            End If
         End If
         'Chiudiamo l'handle al processo
         lRet = CloseHandle(hProcess)
      Next
   End Select
End Sub
---------------------------------------------------
Occhio! La prossima è lunga!
E ora diventiamo tutti assassini con...
--------------------------------------------------- TERMINARE UN PROCESSO
Option Explicit
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const ANYSIZE_ARRAY = 1
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const SE_DEBUG_NAME = "SeDebugPrivilege"
Public Const SE_PRIVILEGE_ENABLED = &H2
Type LARGE_INTEGER
   lowpart As Long
   highpart As Long
End Type
Type Luid
   lowpart As Long
   highpart As Long
End Type
Type LUID_AND_ATTRIBUTES
   pLuid As Luid
   Attributes As Long
End Type
Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32.dll" _
   (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As
Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
   "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
   ByVal lpName As String, lpLuid As Luid) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
   (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
   NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
   PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcess Lib "kernel32" _
   (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
   ByVal dwProcessId As Long) As Long
Declare Function TerminateProcess Lib "kernel32" _
   (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Function KillApplication(ApplicationPID As Long) As Boolean
   Dim hProcessID As Long         'Handle al processo da terminare
   Dim hProcess As Long           'Handle processo corrente
   Dim hToken As Long             'Handle al token del processo
   Dim lPrivilege As Long         'Privilegio da abilitare/disabilitare
   Dim iPrivilegeflag As Boolean  'Flag da usare per abilitare/disabilitare
il privilegio
   Dim lResult As Long            'Risultato di alcune chiamate API
   KillApplication = False
   'settiamo l'id dell'applicazione da terminare a quello passato
sull'argomento
   hProcessID = ApplicationPID
   'otteniamo l'handle di questo processo
   hProcess = GetCurrentProcess
   'Alcune operazioni vanno eseguite solo su Windows NT/2000
   If getVersion=2 Then
      'apriamo il token per questo processo
      lResult = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or
TOKEN_QUERY, hToken)
      'Se OpenProcessToken fallisce, il risultato ritornato è zero.
Controlliamo:
      If (lResult = 0) Then
         CloseHandle (hToken)
         Exit Function
      End If
      'Ora che abbiamo il token di questo processo, settiamo il privilegio
SE_DEBUG_NAME
      lResult = SetPrivilege(hToken, SE_DEBUG_NAME, True)
      'Assicuriamoci che l'operazione sia andata a buon fine
      If (lResult = False) Then
         CloseHandle (hToken)
         Exit Function
      End If
   'Ora che abbiamo cambiato i privilegi su questo token possiamo chiudere
il
   'processo identificato dall' ApplicationPID passato per argomento
   End If   'Su Windows 9x/Me non abbiamo bisogno di ottenere permessi
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID)
   'Assicuriamoci di aver agganciato correttamente il processo
   If (hProcess = Null) Then
      If getVersion=2 Then CloseHandle (hToken)
      Exit Function
   End If
   If getVersion()=2 Then
      'Ora disattiviamo il privilegio SE_DEBUG_NAME (non ci serve più)
      lResult = SetPrivilege(hToken, SE_DEBUG_NAME, False)
      'Assicuriamoci di essere riusciti a tornare alla situazione normale
      If (lResult = False) Then
         CloseHandle (hProcess)
         CloseHandle (hToken)
         Exit Function
      End If
   End If
   'Possiamo terminare l'applicazione richiesta
   lResult = TerminateProcess(hProcess, 0)
   'Controlliamo il risultato
   If (lResult = 0) Then
      CloseHandle (hProcess)
      If getVersion()=2 Then CloseHandle (hToken)
      Exit Function
   End If
   'Chiudiamo gli handler utilizzati
   CloseHandle (hProcess)
   If getVersion=2 Then CloseHandle (hToken)
   KillApplication = True
End Function
'La funzione SetPrivilege accetta un handle a un token, un privilegio e un
flag
'che indichi se abilitare o disabilitare detto privilegio. La funzione tenta
di
'eseguire l'azione richiesta sul token, ritornando TRUE se riesce, FALSE
altrimenti.
Private Function SetPrivilege(hToken As Long, Privilege As String, bSetFlag
As Boolean) As Boolean
   Dim TP As TOKEN_PRIVILEGES          'Usato per ottenere gli attuali
privilegi del token
   Dim TPPrevious As TOKEN_PRIVILEGES  'Usato per impostare i nuovi
privilegi
   Dim Luid As Luid                    'Memorizza il Local Unique Identifier
   Dim cbPrevious As Long              'Dimensione precedente della
struttura TOKEN_PRIVILEGES
   Dim lResult As Long                 'Risultato di alcune chiamate API
   'Otteniamo la dimensione della struttura TOKEN_PRIVILEGES
   'usato per eseguire le chiamate API.
   cbPrevious = Len(TP)
   'Otteniamo il LUID per il privilegio richiesto
   lResult = LookupPrivilegeValue("", Privilege, Luid)
   'Se LoopupPrivilegeValue fallisce ritorna zero. Controlliamo:
   If (lResult = 0) Then
      SetPrivilege = False
      Exit Function
   End If
   'Prepariamo le informazioni primarie per la chiamata.
   'Vogliamo recuperare i privilegi correnti del token in questione
   'prima di poterlo modificare
   TP.PrivilegeCount = 1
   TP.Privileges(0).pLuid = Luid
   TP.Privileges(0).Attributes = 0
   SetPrivilege = lResult
   'Prima dobbiama prelevare i privilegi attuali
   lResult = AdjustTokenPrivileges(hToken, -1, TP, Len(TP), TPPrevious,
cbPrevious)
   'Se AdjustTokenPrivileges ritorna zero l'operazione è fallita.
Controlliamo:
   If (lResult = 0) Then
      SetPrivilege = False
      Exit Function
   End If
   'Ora possiamo preparare le informazioni di privilegio del token
   'in modo che contengano le richieste dell'utente
   TPPrevious.PrivilegeCount = 1
   TPPrevious.Privileges(0).pLuid = Luid
   'A seconda del flag, abilitiamo o disabilitiamo i privilegi
   Select Case bSetFlag
      Case True: TPPrevious.Privileges(0).Attributes = _
                       TPPrevious.Privileges(0).Attributes _
                       Or (SE_PRIVILEGE_ENABLED)
      Case False: TPPrevious.Privileges(0).Attributes = _
                        TPPrevious.Privileges(0).Attributes _
                        Xor (SE_PRIVILEGE_ENABLED And _
                        TPPrevious.Privileges(0).Attributes)
   End Select
   'Eseguiamo la chiamata
   lResult = AdjustTokenPrivileges(hToken, -1, TPPrevious, cbPrevious, TP,
cbPrevious)
   'Determiniamo il risultato finale
   If (lResult = 0) Then
      'Non è stato possibile modificare i privilegi di questo token
      SetPrivilege = False
   Else
      'I privilegi sono stati modificati
      SetPrivilege = True
   End If
End Function
---------------------------------------------------
E que..que...que...questo è tutto, amici!!!
Alla prossima!