Lister,detruire,lancer processus & services a distance

Télécharger le projet
Commenter

Description

Cet application permet de killer ou ajouter un processus, stopper un service ou relancer
Le tout a distance ou en local.
!!! Il faut que WMI soit installé !!!
Sous W2K il y est d'office ....

Source / Exemple : 


Dim distant As Boolean 'Savoir si on test a distance
Dim serveur As String 'Si oui : le nom du serveur
Dim tipe As Boolean 'Process ou service
Dim run As Integer 'Nb de services lancés
Dim sto As Integer 'Nb de services stoppé
Private Sub Check1_Click()

If Check1.Value = 1 Then 'Clicke
    lblserv.Visible = True
    cmdhelp.Visible = True 'Affiche les options
    txtserv.Visible = True
    distant = True 'Oui pour a distance
Else
    lblserv.Visible = False
    cmdhelp.Visible = False 'Cache
    txtserv.Visible = False
    distant = False
End If

End Sub

Private Sub cmdadproc_Click()
cd.Filter = "Application (*.exe)|*.exe|" 'Filtre pour la boite de diag ouvrir
cd.ShowOpen 'Ouvre la boite de dialogue
test = cd.FileName 'Recupere le chemin
If test <> "" Then Shell (test) 'Lance le processus
End Sub

Private Sub cmddelproc_Click()

Dim ServiceObject As SWbemObject 'Objet WMI
Dim Locator As SWbemLocator 'Objet de connexion
Dim services As SWbemServices 'Objet services

Set Locator = New SWbemLocator 'Nouvelle insatance d'une connexion

'Verifie si qqc est selectionné dans le listview1
If ListView1.SelectedItem.Selected = False Then MsgBox "Vous devez selectionné un processus", vbCritical: Exit Sub

'Handle du processus
proc$ = ListView1.SelectedItem.SubItems(1)

'Index de la ligne selectionné
ligne = ListView1.SelectedItem.Index

'Connexion au serveur
Set services = Locator.ConnectServer(txtserv.Text)

'Recuperation du processus selectionné
Set ServiceObject = services.Get("Win32_Process='" & proc & "'")
        'Destruction du processus
        p = ServiceObject.Terminate

'Le kill a reussi
If p <> 0 Then
MsgBox "Suppression du process " & ListView1.SelectedItem.Text & "(" & proc & ")" & " impossible", vbCritical
'Le kill a echoué
Else: MsgBox "Suppression terminé de " & ListView1.SelectedItem.Text, vbOKOnly + vbInformation
End If

'Maj de la liste des processus
maj (0)
End Sub

Private Sub cmdhelp_Click()
'Aide
msg = "Permet de tester les services" & vbCrLf & " ou procesus sur un ordinateur distant équipé de WMI"
MsgBox msg, vbOKOnly + vbQuestion, "Management"
End Sub

Private Sub cmdmaj_Click()
'Mise à jour
maj (cmdstart.Visible)
End Sub

Private Sub cmdproc_Click()
Dim liste 'Collection de processus
Dim element 'Un element de la collection

tipe = 0 'Processus

'Affiche les bouton relatfs aux processus , cache les autres
cmdstart.Visible = False
cmdstop.Visible = False
frmserv.Visible = False
cmdadproc.Visible = True
cmddelproc.Visible = True

'Modification du label de compte
lbltest.Caption = "Nb processus"

'Efface la liste
ListView1.ListItems.Clear

'Remet les en-têtes
ListView1.ColumnHeaders.Item(1) = "Nom"
ListView1.ColumnHeaders.Item(2) = "Identifiant"

'Selon le test à distance ou pas
Select Case distant
    Case 1:
        'Nom du serveur
        serveur = txtserv.Text
        'Recuperation des processus
        Set liste = GetObject("winmgmts://" & serveur).InstancesOf("Win32_Process")
        
    Case 0:
        'Recuperation des processus
        Set liste = GetObject("winmgmts:").InstancesOf("Win32_Process")
               
End Select

For Each element In liste
            'Insertion dans la listview
            Set Item = ListView1.ListItems.Add(, , element.Name)
            Item.SubItems(1) = element.Handle
            Item.SubItems(2) = element.VirtualSize
Next element
maj (tipe)
End Sub

Private Sub cmdserv_Click()

Dim objcol 'Collection de service
tipe = 1 'SErvice

'Affichage des boutons relatifs aux services cache des autres
cmdstart.Visible = True
cmdstop.Visible = True
frmserv.Visible = True
cmdadproc.Visible = False
cmddelproc.Visible = False

'Mise a jour du label de comptage
lbltest.Caption = "Nb Services"

'Efface la liste
ListView1.ListItems.Clear

'En tete des colonne
ListView1.ColumnHeaders.Item(1) = "Nom"
ListView1.ColumnHeaders.Item(2) = "Etat"
ListView1.ColumnHeaders.Item(3) = "Description"

'Selon cas a distance ou pas
Select Case distant
    Case 1:
    
    'Nom du serveur
    serveur = txtserv.Text
    
    'Recuperation a distance des services
    Set objcol = GetObject("WinMgmts://" & serveur & "/root/cimv2").InstancesOf("Win32_service")
    
    Case 0:
    'Recuperation en local des services
    Set objcol = GetObject("WinMgmts:").InstancesOf("Win32_service")
End Select

For Each element In objcol

    'Insertion des services dans la listview
    Set Item = ListView1.ListItems.Add(, , element.Name)
    Item.SubItems(2) = element.Description
    Item.SubItems(1) = element.state
Next element

'Mise a jour
maj (tipe)
End Sub

Private Sub cmdstart_Click()
Dim ServiceObject As SWbemObject 'Objet WMI
Dim Locator As SWbemLocator 'Objet de connexion
Dim services As SWbemServices 'objet service

Set Locator = New SWbemLocator 'Nouvelle instance de connexion

'Verifie que qqc est selectionné
If ListView1.SelectedItem.Selected = False Then MsgBox "Vous devez selectionné un service", vbCritical: Exit Sub

'Recupere la selection
service$ = ListView1.SelectedItem.Text
ligne = ListView1.SelectedItem.Index

'REgarde si il n'est pas deja lancé
If ListView1.SelectedItem.SubItems(1) = "Running" Then
MsgBox "Le service est dejà demarré"
Exit Sub

Else
'SE connecte
Set services = Locator.ConnectServer(txtserv.Text)

'Recupere le service
Set ServiceObject = services.Get("Win32_Service='" & service & "'")
        'Le demarre
        ServiceObject.StartService
End If

'Mise a jour
maj (cmdstop.Visible)
End Sub

Private Sub cmdstop_Click()
Dim ServiceObject As SWbemObject
Dim Locator As SWbemLocator
Dim services As SWbemServices
Set Locator = New SWbemLocator

If ListView1.SelectedItem.Selected = False Then MsgBox "Vous devez selectionné un service", vbCritical: Exit Sub

service$ = ListView1.SelectedItem.Text
ligne = ListView1.SelectedItem.Index

If ListView1.SelectedItem.SubItems(1) = "Stopped" Then
MsgBox "Le service est dejà stoppé"
Exit Sub

Else
On Error GoTo error
Set services = Locator.ConnectServer(txtserv.Text)
Set ServiceObject = services.Get("Win32_Service='" & service & "'")
        'L'arrete
        ServiceObject.Stopservice
error:
    MsgBox "Le service n'a pu etre stoppé"
End If
maj (cmdstop.Visible)
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
   ' Quand vous cliquez sur un objet ColumnHeader, le contrôle
   ' ListView trie selon les sous-éléments de cette colonne.
   ' Affecte à la propriété SortKey l'index de ColumnHeader - 1
   ListView1.SortKey = ColumnHeader.Index - 1
   ' Affecte à la propriété Sorted la valeur True afin de trier la
   ' liste.
   ListView1.Sorted = True
End Sub

Private Sub maj(tipe As Boolean)

'Efface la list
ListView1.ListItems.Clear

run = 0 'Met a 0 le compteur de service lancé
sto = 0 'Idem pour les services stoppés
compte = 0 'Compte les processus et services

Select Case tipe
Case 0:
    'On met a jour les processus
    Select Case distant
    Case 1:
        serveur = txtserv.Text
        Set liste = GetObject("winmgmts://" & serveur).InstancesOf("Win32_Process")
        
    Case 0:
        Set liste = GetObject("winmgmts:").InstancesOf("Win32_Process")
               
End Select

For Each element In liste
            Set Item = ListView1.ListItems.Add(, , element.Name)
            Item.SubItems(1) = element.Handle
            Item.SubItems(2) = element.VirtualSize
            compte = compte + 1
            lblcompte.Caption = compte
            DoEvents
            
Next element

Case 1:

Select Case distant
    Case 1:
    serveur = txtserv.Text
    Set objcol = GetObject("WinMgmts://" & serveur & "/root/cimv2").InstancesOf("Win32_service")
    
    Case 0:
    
    Set objcol = GetObject("WinMgmts:").InstancesOf("Win32_service")

End Select

For Each element In objcol
    Set Item = ListView1.ListItems.Add(, , element.Name)
    
        Item.SubItems(2) = element.Description
        Item.SubItems(1) = element.state
            
        If element.state = "Running" Then
            run = run + 1
            Else: sto = sto + 1
        End If
        compte = compte + 1
        lblarr.Caption = "Arretés : " & sto
        lbldem.Caption = "Demarrés : " & run
        lblcompte.Caption = compte
        
        DoEvents
Next element

End Select
'lblcompte.Caption = ListView1.ListItems.Count

End Sub

Private Sub ListView1_DblClick()
MsgBox ListView1.SelectedItem.Text & " " & ListView1.SelectedItem.SubItems(1)
End Sub

Conclusion :


Il y a le Zeep

*
08/030/03 : Mise à jour d'un bug lorsque que la description d'un service etait null
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (TheSaib)