LISTER LES SERVICES + INFOS + PAUSE/STOP/START + CHANGEMENT DE TYPE DE DEMARRAG
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
-
1 sept. 2006 à 21:03
violent_ken Messages postés 1812 Date d'inscription mardi 31 mai 2005 Statut Membre Dernière intervention 26 octobre 2010 - 14 janv. 2007 à 23:42
violent_ken Messages postés 1812 Date d'inscription mardi 31 mai 2005 Statut Membre Dernière intervention 26 octobre 2010 - 14 janv. 2007 à 23:42
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/39391-lister-les-services-infos-pause-stop-start-changement-de-type-de-demarrage-methode-api-enum-et-registre
https://codes-sources.commentcamarche.net/source/39391-lister-les-services-infos-pause-stop-start-changement-de-type-de-demarrage-methode-api-enum-et-registre
14 janv. 2007 à 23:42
@+ ^_-
4 sept. 2006 à 22:21
Pour ceux que ca interesse, voici un exemple concret avec la methode que j'ai cite plus haut (via QueryServiceConfig)
http://systemzeb.free.fr/ServiceInfo.zip
++
4 sept. 2006 à 16:42
Les types BOOT_START et SYSTEM_START ne peuvent être appliqués par l'utilisateur.
@+
4 sept. 2006 à 16:20
Pleins de petits détails qui améliorent le tout.
Le changement de type de démarrage est presque terminé...
Encore quelques fonctions à rajouter avant de faire une classe ^^
Merci encore, @+
4 sept. 2006 à 16:09
Quelques conseils, suite au test du programme :
Enlève le MultiSelect
dans le MouseDown, selectionne l'item survollé :
Private Sub LV8_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Item As ListItem
If Button = 2 Then
Set Item = LV8.HitTest(x, y)
If Not Item Is Nothing Then
Item.Selected = True
tu peux activer le tri dans le Form_Load :
LV8.SortKey = 0
LV8.SortOrder = lvwAscending
LV8.Sorted = True
pour le tri, toujours, met en ASC par defaut :
Private Sub LV8_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'réorganise les objets du listview
If LV8.SortKey = ColumnHeader.Index - 1 Then
If Not LV8.SortOrder = lvwAscending Then
LV8.SortOrder = lvwAscending
Else
LV8.SortOrder = lvwDescending
End If
Else
LV8.SortKey = ColumnHeader.Index - 1
LV8.SortOrder = lvwAscending
End If
End Sub
pour placer dans le clipboard, évite de faire de multiples concaténations :
Private Sub copy_to_clipboard_Click()
'copie dans le clipboard les infos sur le service
Dim sBuffer As String
On Error Resume Next
With LV8.SelectedItem
Clipboard.Clear
sBuffer = "Service=" & .Text & vbNewLine & _
"Désignation=" & .SubItems(1) & vbNewLine & _
"Etat=" & .SubItems(2) & vbNewLine & _
"Type de service=" & .SubItems(3) & vbNewLine & _
"Le service accepte=" & .SubItems(4) & vbNewLine & _
"CheckPoint=" & .SubItems(5) & vbNewLine & _
"WaitHint=" & .SubItems(6) & vbNewLine & _
"DependOnService=" & .SubItems(7) & vbNewLine & _
"Description=" & .SubItems(8) & vbNewLine & _
"DiagnosticsMessageFile=" & .SubItems(9) & vbNewLine & _
"ErrorControl=" & .SubItems(10) & vbNewLine & _
"FailureActions=" & .SubItems(11) & vbNewLine & _
"Group=" & .SubItems(12) & vbNewLine & _
"ImagePath=" & .SubItems(13) & vbNewLine & _
"ObjectName=" & .SubItems(14) & vbNewLine & _
"Start=" & .SubItems(15) & vbNewLine & _
"Tag=" & .SubItems(16) & vbNewLine
Clipboard.SetText sBuffer
End With
End Sub
un On error évité en faisant :
Private Sub LV8_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtInfo.Text = Item.SubItems(8)
End Sub
au lieu de ton LV8_Click()
deuxième avantage, ca fonctionne même quand on se déplace avec les touches fléchées...
prochaine étape : créer la classe CService ^^ avec propriétés, méthodes, etc
4 sept. 2006 à 15:41
@+
4 sept. 2006 à 15:39
Bientôt (peut être) la possibilité de changer le type de démarrage du service.
@+
4 sept. 2006 à 13:13
-Corrections apportées par Renfield (merci!)
-ajout d'une textbox pour mieux voir la description
-copie dans le clipboard avec le clic droit
-classement lors du clic sur les columnheader
-interprétation des valeurs Start et ErrorControl
Encore merci, @+
4 sept. 2006 à 12:10
En effet tu peux avoir toutes les infos dans la bdr, mais il te faut alors gerer les REG_MULTI_SZ les REG_EXPAND, les DWORD et les BINARY, et donc je pense que c'est plus simple d'utiliser l'api prevu pour les services, apres c'est une question de choix...
++
4 sept. 2006 à 11:58
@+
4 sept. 2006 à 11:37
Tout d'abord.... il y a eu beaucoup de commentaires ce Week End ! Désolé de ne pas avoir répondu sur le moment, j'étais absent...
Alors, je commence par le début, et la remarque de Renfield. "SERVICE_WIN32 Or SERVICE_ADAPTER Or SERVICE_DRIVER Or SERVICE_INTERACTIVE_PROCESS" remplace "SERVICE_WIN32" dans la deuxième déclaration, c'est une erreur ridicule, j'ai oublié pendant mon débuggage de remplacer l'argument aux deux endroits....donc en effet, la nouvelle version affiche désormais les services de type SERVICE_WIN32, SERVICE_ADAPTER, SERVICE_INTERACTIVE_PROCESS en plus.
Concernant les modifications apportées par Renfield... tout d'abord le code fonctionne désormais sans problèmes.
Ensuite, le code en lui même est évidemment bien meilleur. Et c'est ce dernier point le plus important : j'ai vu comment une source que j'avais tappée moi même (avec une mauvaise identation comme tu le rappellais tout au début) se transforme en un code véritablement plus propre, mieux structuré, plus rigoureux. De ce point de vu là, j'en ai appris énormément sur le style préconisé.
Je te remercie infiniment pour la correction apportée à la source et pour les conseils que tu me donnes à travers la nouvelle version. Vraiment, tu as du y passer du temps, mais ce n'est absolument pas du temps perdu.
Concernant l'API citée par Draluorg, je ne la connaissais en effet pas, et je dois dire que les résultats donnés par ta fonction GetServiceInfo sont meilleurs que ceux fournis par la BDR : exemple avec l'élément 'Start' qui ne renvoie pas des valeurs nulles (contrairement au registre).
On peut ensuite en tirer l'information concernant le type de démarrage (manuel, désactivé, automatique)...
Je vais tout d'abord procéder à la mise à jour de la source (avec la version donnée par Renfiled) ; le code est meilleur et sans bugs. Je vais voir ensuite qu'est ce qu'il en est de l'API QueryServiceConfig, la méthode de Draluorg est (très) intéressante.
Dernières remarques, sur les 'services' de type KERNEL_DRIVER, j'obtiens personnellement des informations, au même titre que les FILE_SYSTEM_DRIVER, WIN_32.
Et pour
Private Sub LV8_Click()
MsgBox LV8.SelectedItem.ListSubItems(8)
End Sub
, je vais plutôt opter pour un affichage de la descritpion dans une TextBox en bas de la form. Il est en effet prévu dans le projet entier d'afficher un menu (clic droit) pour pouvoir arrêter, démarrer, mettre en pause les services.
Merci énormément.
@+
3 sept. 2006 à 21:21
Eh le StrFromPtr est donne plus haut par RenField, c'est juste un CopyMemory ou un lstrcpy...
Sinon ca ne renvoi pas toutes les infos, mais les principales, moi perso ca me suffit...
++
3 sept. 2006 à 20:28
StrFromPtr > Tu as le code de la fonction ?
PS : je ne me suis jamais encore interessé aux services, mais d'un point de vue strictement ignorant, je trouve effectivement plus sympa de récupérer les infos grace à des api plutot que dans la bdr (après peut etre qu'on peut récupérer moins d'infos comme ça ??)
3 sept. 2006 à 19:28
Code interessant ^^
M'interessant actuelement aussi aux services, j'ai creuse un peu et j'ai trouve un autre moyen pour lire les infos d'un sercvice que de lire dans la bdr, via l'api QueryServiceConfig
J'ai cree un petit exemple facilement adaptable a cette source:
Private Declare Function OpenService Lib "advapi32.dll" Alias "OpenServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal dwDesiredAccess As Long) As Long
Private Declare Function QueryServiceConfig Lib "advapi32.dll" Alias "QueryServiceConfigA" (ByVal hService As Long, _
lpServiceConfig As Byte, _
ByVal cbBufSize As Long, _
pcbBytesNeeded As Long) As Long
Public Type QUERY_SERVICE_CONFIG
dwServiceType As Long
dwStartType As Long
dwErrorControl As Long
lpBinaryPathName As Long 'String
lpLoadOrderGroup As Long ' String
dwTagId As Long
lpDependencies As Long 'String
lpServiceStartName As Long 'String
lpDisplayName As Long 'String
End Type
Private Sub GetServiceInfo(ByRef Service As Service)
Dim hSCM As Long
Dim hService As Long
Dim nBufferSize As Long
Dim QSC As QUERY_SERVICE_CONFIG
Dim ByteArray() As Byte
ReDim ByteArray(0) As Byte
hSCM = OpenSCManager(vbNullString, vbNullString, GENERIC_READ)
If hSCM <> 0 Then
hService = OpenService(hSCM, Service.ServiceName, GENERIC_READ) '
If hService <> 0 Then
QueryServiceConfig hService, ByteArray(0), 0&, nBufferSize
If nBufferSize > 0 Then
ReDim ByteArray(nBufferSize) As Byte
QueryServiceConfig hService, ByteArray(0), nBufferSize, nBufferSize
CopyMemory QSC, ByteArray(0), Len(QSC)
End If
CloseServiceHandle hService
End If
CloseServiceHandle hSCM
End If
Service.DependOnService = StrFromPtr(QSC.lpDependencies)
Service.ImagePath = StrFromPtr(QSC.lpBinaryPathName)
Service.ErrorControl = QSC.dwErrorControl
Service.Start = QSC.dwStartType
Service.Group = StrFromPtr(QSC.lpLoadOrderGroup)
Service.ObjectName = StrFromPtr(QSC.lpServiceStartName)
Service.ServiceType = QSC.dwServiceType
End Sub
3 sept. 2006 à 14:29
je ne me suis pas trop impliqué dans les services, etc...
3 sept. 2006 à 14:00
Avec ce que j'avais proposé:
Private Sub LV8_Click()
MsgBox LV8.SelectedItem.ListSubItems(8)
End Sub
Je m'aperçois que l'on n'a aucune info si le type de service est KERNEL_DRIVER.
3 sept. 2006 à 10:55
en effet, les chaines sont en Unicode.
il suffit de modifier la déclaration de lstrlen et la fonction StrFromPtr :
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Function StrFromPtr(ByVal vnStringPtr As Long, Optional vnMaxSize As Long = 256) As String
Dim nLength As Long
If Not IsBadStringPtr(vnStringPtr, vnMaxSize) Then
nLength = lstrlen(vnStringPtr) * 2
StrFromPtr = Space$(nLength)
CopyMemory ByVal StrFromPtr, ByVal vnStringPtr, nLength
End If
End Function
3 sept. 2006 à 09:26
En effet, cette fois on peut compiler.
Ta version affiche nettement plus de services qu'avant.En effet on ne voyait pas les KERNEL_DRIVER dans les types de service.
Par contre, dans la 2ème colonne, les infos de description sont super tronquées bien que la largeur de la colonne soit grande.Pourquoi? Nouveau mystère.
En tout cas, merci beaucoup Renfield
3 sept. 2006 à 02:49
Comme tu peux le voir, le code ne ressemble plus trop au code de la KB183478.
Ce que j'ai fait m'a pris du temps, j'ai eu droit à un bon nombre de plantages de VB et de l'exe, mais ca en valait, je pense la peine.
N'hésites pas a consulter les docs MSDN des APIs, ca t'eviteras des problèmes, et ca t'apprendra plein de choses, j'en suis sur.
Je pense que tu as du potentiel, reste à ce que tu gagne encore en rigueur...
3 sept. 2006 à 02:42
Option Explicit
Private Sub cmdEnd_Click()
Unload Me
End Sub
Private Sub cmdGo_Click()
Dim xlpServices() As SERVICE
Dim i As Long
'# On efface la liste
LV8.ListItems.Clear
If Create_Services_List(xlpServices()) > 0 Then
For i = 0 To UBound(xlpServices())
With LV8.ListItems.Add
.Text = xlpServices(i).ServiceName
.SubItems(1) = xlpServices(i).DisplayName
Select Case xlpServices(i).State
Case START_PENDING
.SubItems(2) = "Start Pending"
Case STOPPED
.SubItems(2) = "Stopped"
Case STOP_PENDING
.SubItems(2) = "Stop Pending"
Case RUNNING
.SubItems(2) = "Runing"
Case CONTINUE_PENDING
.SubItems(2) = "Continue Pending"
Case PAUSE_PENDING
.SubItems(2) = "Pause Pending"
Case PAUSED
.SubItems(2) = "Paused"
Case Else
.SubItems(2) = "Unknown"
End Select
Select Case xlpServices(i).ServiceType
Case INTERACTIVE_PROCESS
.SubItems(3) = "INTERACTIVE_PROCESS"
Case KERNEL_DRIVER
.SubItems(3) = "KERNEL_DRIVER"
Case FILE_SYSTEM_DRIVER
.SubItems(3) = "FILE_SYSTEM_DRIVER"
Case WIN32_OWN_PROCESS
.SubItems(3) = "WIN32_OWN_PROCESS"
Case WIN32_SHARE_PROCESS
.SubItems(3) = "WIN32_SHARE_PROCESS"
Case Else
.SubItems(3) = "OTHER"
End Select
.SubItems(4) = xlpServices(i).AcceptedControls
.SubItems(5) = xlpServices(i).CheckPoint
.SubItems(6) = xlpServices(i).WaitHint
.SubItems(7) = xlpServices(i).DependOnService
.SubItems(8) = xlpServices(i).Description
.SubItems(9) = xlpServices(i).DiagnosticsMessageFile
.SubItems(10) = xlpServices(i).ErrorControl
.SubItems(11) = xlpServices(i).FailureActions
.SubItems(12) = xlpServices(i).Group
.SubItems(13) = xlpServices(i).ImagePath
.SubItems(14) = xlpServices(i).ObjectName
.SubItems(15) = xlpServices(i).Start
.SubItems(16) = xlpServices(i).Tag
End With
Next i
End If
End Sub
Private Sub Form_Load()
'# initialise le ListView
LV8.ListItems.Clear
LV8.View = lvwReport
With LV8.ColumnHeaders
.Clear
.Add Text:="Service", Width:=3000
.Add Text:="Description", Width:=2500
.Add Text:="Etat", Width:=1000
.Add Text:="Type de service", Width:=2000
.Add Text:="Le service accepte", Width:=2000
.Add Text:="CheckPoint", Width:=800
.Add Text:="WaitHint", Width:=800
.Add Text:="DependOnService", Width:=2000
.Add Text:="Description", Width:=3000
.Add Text:="DiagnosticsMessageFile", Width:=1000
.Add Text:="ErrorControl", Width:=1000
.Add Text:="FailureActions", Width:=1000
.Add Text:="Group", Width:=800
.Add Text:="ImagePath", Width:=3000
.Add Text:="ObjectName", Width:=1500
.Add Text:="Start", Width:=800
.Add Text:="Tag", Width:=800
End With
End Sub
Private Sub Form_Resize()
'resize la form pour pouvoir augmenter la zone de vue du listview
With LV8
.Left = 0
.Top = 0
.Height = Me.ScaleHeight - 1000
.Width = Me.ScaleWidth - 120
End With
cmdEnd.Top = Me.ScaleHeight - 750
cmdGo.Top = Me.ScaleHeight - 750
End Sub
3 sept. 2006 à 02:42
Option Explicit
Private Const SERVICE_KERNEL_DRIVER = &H1
Private Const SERVICE_FILE_SYSTEM_DRIVER = &H2
Private Const SERVICE_ADAPTER = &H4
Private Const SERVICE_RECOGNIZER_DRIVER = &H8
Private Const SERVICE_DRIVER = (SERVICE_KERNEL_DRIVER Or SERVICE_FILE_SYSTEM_DRIVER Or SERVICE_RECOGNIZER_DRIVER)
Private Const SERVICE_WIN32_OWN_PROCESS = &H10
Private Const SERVICE_WIN32_SHARE_PROCESS = &H20
Private Const SERVICE_WIN32 = (SERVICE_WIN32_OWN_PROCESS Or SERVICE_WIN32_SHARE_PROCESS)
Private Const SERVICE_INTERACTIVE_PROCESS = &H100
Private Const SERVICE_TYPE_ALL = (SERVICE_WIN32 Or SERVICE_ADAPTER Or SERVICE_DRIVER Or SERVICE_INTERACTIVE_PROCESS)
'états des services
Private Const SERVICE_ACCEPT_HARDWAREPROFILECHANGE As Long = &H20
Private Const SERVICE_ACCEPT_NETBINDCHANGE As Long = &H10
Private Const SERVICE_ACCEPT_PARAMCHANGE As Long = &H8
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE As Long = &H2
Private Const SERVICE_ACCEPT_POWEREVENT As Long = &H40
Private Const SERVICE_ACCEPT_SESSIONCHANGE As Long = &H80
Private Const SERVICE_ACCEPT_PRESHUTDOWN As Long = &H100
Private Const SERVICE_ACCEPT_SHUTDOWN As Long = &H4
Private Const SERVICE_ACCEPT_STOP As Long = &H1
Private Const SERVICE_ACTIVE = &H1
Private Const SERVICE_CHANGE_CONFIG = &H2
Private Const SERVICE_CONTINUE_PENDING = &H5
Private Const SERVICE_CONTROL_CONTINUE = &H3
Private Const SERVICE_CONTROL_INTERROGATE = &H4
Private Const SERVICE_CONTROL_PAUSE = &H2
Private Const SERVICE_CONTROL_SHUTDOWN = &H5
Private Const SERVICE_CONTROL_STOP = &H1
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
Private Const SERVICE_INACTIVE = &H2
Private Const SERVICE_INTERROGATE = &H80
Private Const SERVICE_NO_CHANGE = &HFFFF
Private Const SERVICE_PAUSE_CONTINUE = &H40
Private Const SERVICE_PAUSE_PENDING = &H6
Private Const SERVICE_PAUSED = &H7
Private Const SERVICE_QUERY_CONFIG = &H1
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_RUNNING = &H4
Private Const SERVICE_START = &H10
Private Const SERVICE_START_PENDING = &H2
Private Const SERVICE_STOP = &H20
Private Const SERVICE_STOP_PENDING = &H3
Private Const SERVICE_STOPPED = &H1
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
'utilisé pour la gestion des services
Private Const ERROR_MORE_DATA = 234
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
'//TYPE & ENUM
'type contenant des infos sur les services
Public Type SERVICE_STATUS
dwServiceType As Long
dwCurrentState As Long
dwControlsAccepted As Long
dwWin32ExitCode As Long
dwServiceSpecificExitCode As Long
dwCheckPoint As Long
dwWaitHint As Long
End Type
'id
Public Type ENUM_SERVICE_STATUS
lpServiceName As Long
lpDisplayName As Long
ServiceStatus As SERVICE_STATUS
End Type
'enum contenant le type d'un service
Public Enum SERVICE_TYPE
INTERACTIVE_PROCESS = SERVICE_INTERACTIVE_PROCESS
WIN32_SHARE_PROCESS = SERVICE_WIN32_SHARE_PROCESS
WIN32_OWN_PROCESS = SERVICE_WIN32_OWN_PROCESS
FILE_SYSTEM_DRIVER = SERVICE_FILE_SYSTEM_DRIVER
KERNEL_DRIVER = SERVICE_KERNEL_DRIVER
End Enum
'enum contenant l'état d'un service
Public Enum SERVICE_STATE
STOPPED = SERVICE_STOPPED
START_PENDING = SERVICE_START_PENDING
STOP_PENDING = SERVICE_STOP_PENDING
RUNNING = SERVICE_RUNNING
CONTINUE_PENDING = SERVICE_CONTINUE_PENDING
PAUSE_PENDING = SERVICE_PAUSE_PENDING
PAUSED = SERVICE_PAUSED
End Enum
'type contenant toutes les infos sur un service
Public Type SERVICE
ServiceName As String
DisplayName As String
State As SERVICE_STATE
ServiceType As SERVICE_TYPE
AcceptedControls As String
CheckPoint As Long
WaitHint As Long
'# Pour les données ci-dessous, voir :
'# http://www.microsoft.com/technet/prodtechnol/exchange/FR/Guides/E2k3TechRef/881d8b23-d274-4313-a666-88f80c2cfd92.mspx?mfr=true
DependOnService As String 'répertorie les dépendances
Description As String
DiagnosticsMessageFile As String
ErrorControl As Long 'spécifie la gravité de l'erreur et la mesure prise si ce service ne démarre pas
FailureActions As Long 'indique la mesure que le SCM doit prendre à chaque échec de service.
Group As String 'nom du groupe d'ordre de chargement dont ce service est membre
ImagePath As String 'path du fichier
ObjectName As String 'nom du compte sous lequel le service doit s'exécuter
Start As Long 'définition du démarrage du service
Tag As Long 'ordre de démarrage dans le groupe
End Type
'//API
'ouvre le Service Control Manager
Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long
'pour l'énumération
Private Declare Function EnumServicesStatus Lib "advapi32.dll" Alias "EnumServicesStatusA" (ByVal hSCManager As Long, ByVal dwServiceType As Long, ByVal dwServiceState As Long, lpServices As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long, lpServicesReturned As Long, lpResumeHandle As Long) As Long
'ferme le handle d'un service ouvert
Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As Long) As Long
'copie une string vers un buffer
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Const MEM_RELEASE As Long = &H8000
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_READWRITE As Long = &H4
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function VirtualLock Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long) As Long
Private Function StrFromPtr(ByVal vnStringPtr As Long, Optional vnMaxSize As Long = 256) As String
Dim nLength As Long
If Not IsBadStringPtr(vnStringPtr, vnMaxSize) Then
nLength = lstrlen(vnStringPtr)
StrFromPtr = Space$(nLength)
CopyMemory ByVal StrFromPtr, ByVal vnStringPtr, nLength
End If
End Function
Public Function Create_Services_List(ByRef vslpServices() As SERVICE) As Long
Dim hSCM As Long
Dim xlpESS() As ENUM_SERVICE_STATUS
Dim nBufferSize As Long
Dim nServicesCount As Long
Dim i As Long
Dim sBuffer As String
Dim hMem As Long
'# On vide le tableau des résultats
Erase vslpServices
'# ouvre la connection au Service Control Manager
hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ENUMERATE_SERVICE)
If hSCM <> 0 Then
'# Obtient la taille nécessaire pour récupérer les données
EnumServicesStatus hSCM, _
SERVICE_WIN32 Or SERVICE_ADAPTER Or SERVICE_DRIVER Or SERVICE_INTERACTIVE_PROCESS, _
SERVICE_ACTIVE Or SERVICE_INACTIVE, _
ByVal 0&, _
0&, _
nBufferSize, _
nServicesCount, _
ByVal 0&
If nBufferSize > 0 Then
'# On alloue un espace mémoire de la taille requise pour stocker les informations sur les services.
hMem = VirtualAlloc(ByVal 0&, nBufferSize, MEM_COMMIT, PAGE_READWRITE)
If hMem <> 0 Then
VirtualLock ByVal hMem, nBufferSize
'# On récupère les infos
EnumServicesStatus hSCM, _
SERVICE_WIN32 Or SERVICE_ADAPTER Or SERVICE_DRIVER Or SERVICE_INTERACTIVE_PROCESS, _
SERVICE_ACTIVE Or SERVICE_INACTIVE, _
ByVal hMem, _
nBufferSize, _
i, _
nServicesCount, _
ByVal 0&
If nServicesCount > 0 Then
'# On redimensionne nos tableaux
ReDim vslpServices(nServicesCount - 1) As SERVICE
ReDim xlpESS(nServicesCount - 1) As ENUM_SERVICE_STATUS
'# On copie les infos de notre buffer vers le tableau de ENUM_SERVICE_STATUS
CopyMemory xlpESS(0), ByVal hMem, nServicesCount * Len(xlpESS(0))
'# Finallement, on transfère dans le tableau de résultats, des informations exploitables par
'# l'utilisateur.
For i = 0 To nServicesCount - 1
With xlpESS(i)
'# Nom du service
vslpServices(i).ServiceName = StrFromPtr(.lpServiceName)
'# Titre du service
vslpServices(i).DisplayName = StrFromPtr(.lpDisplayName)
'# Le status du service (actif, en pause, ...)
vslpServices(i).State = .ServiceStatus.dwCurrentState
'# Le type de service
vslpServices(i).ServiceType = .ServiceStatus.dwServiceType
'# Ici, la liste des commandes que le service reconnait.
'# Les commentaires en anglais, ci-dessous, sont extraits de MSDN
sBuffer = vbNullString
'# The service is a network component that can accept changes in its binding without being stopped and restarted.
If CBool(SERVICE_ACCEPT_NETBINDCHANGE And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "NETBINDCHANGE ,"
End If
'# The service can reread its startup parameters without being stopped and restarted.
If CBool(SERVICE_ACCEPT_PARAMCHANGE And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "PARAMCHANGE ,"
End If
'# The service can be paused and continued.
If CBool(SERVICE_ACCEPT_PAUSE_CONTINUE And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "PAUSE_CONTINUE ,"
End If
'# The service can perform preshutdown tasks.
If CBool(SERVICE_ACCEPT_PRESHUTDOWN And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "PRESHUTDOWN ,"
End If
'# The service is notified when system shutdown occurs.
If CBool(SERVICE_ACCEPT_SHUTDOWN And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "SHUTDOWN ,"
End If
'# The service can be stopped.
If CBool(SERVICE_ACCEPT_STOP And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "STOP ,"
End If
'# The service is notified when the computer's hardware profile has changed.
If CBool(SERVICE_ACCEPT_HARDWAREPROFILECHANGE And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "HARDWAREPROFILECHANGE ,"
End If
'# The service is notified when the computer's power status has changed.
If CBool(SERVICE_ACCEPT_POWEREVENT And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "POWEREVENT ,"
End If
'# The service is notified when the computer's session status has changed.
If CBool(SERVICE_ACCEPT_SESSIONCHANGE And .ServiceStatus.dwControlsAccepted) Then
sBuffer = sBuffer & "SESSIONCHANGE ,"
End If
If Right$(sBuffer, 1) = "," Then
sBuffer = Left$(sBuffer, Len(sBuffer) - 2)
End If
vslpServices(i).AcceptedControls = sBuffer
vslpServices(i).CheckPoint = .ServiceStatus.dwCheckPoint
vslpServices(i).WaitHint = .ServiceStatus.dwWaitHint
End With
With vslpServices(i)
'# récupère toutes les autres informations depuis le registre
'# voir la déclaration des données, plus haut pour obtenir plus d'infos
.DependOnService = RetrieveServiceInfo(.ServiceName, "DependOnService")
.Description = RetrieveServiceInfo(.ServiceName, "Description")
.DiagnosticsMessageFile = RetrieveServiceInfo(.ServiceName, "DiagnosticsMessageFile")
.ErrorControl = Val(RetrieveServiceInfo(.ServiceName, "ErrorControl"))
.FailureActions = Val(RetrieveServiceInfo(.ServiceName, "FailureActions"))
.Group = RetrieveServiceInfo(.ServiceName, "Group")
.ImagePath = RetrieveServiceInfo(.ServiceName, "ImagePath")
.ObjectName = RetrieveServiceInfo(.ServiceName, "ObjectName")
.Start = Val(RetrieveServiceInfo(.ServiceName, "Start"))
.Tag = Val(RetrieveServiceInfo(.ServiceName, "Tag"))
End With
Next i
'# La fonction renvoie le nombre de services listés
Create_Services_List = nServicesCount
End If
'# On a finit de jouer avec la mémoire reservée plus tôt ; on la libère
VirtualUnlock ByVal hMem, nBufferSize
VirtualFree ByVal hMem, nBufferSize, MEM_RELEASE
End If
End If
'# Enfin, on libère le handle vers le service Control Manager
CloseServiceHandle (hSCM)
End If
End Function
'renvoie les informations souhaitées sur les services
Public Function RetrieveServiceInfo(ByVal sService As String, ByRef sValeur As String) As Variant
Dim sPath As String
Dim hKey As Long
'# créé le path en concaténant path connu et service
sPath = "SYSTEM\CurrentControlSet\Services" & sService
If RegOpenKey(HKEY_LOCAL_MACHINE, sPath, hKey) = 0 Then
'alors on récupère les infos
RetrieveServiceInfo = RegQueryStringValue(hKey, sValeur)
'referme la clé
RegCloseKey hKey
End If
End Function
3 sept. 2006 à 02:40
Module_Registre
// Déclarations...
(non changées)
'# obtient les valeurs formatées en string depuis les valeurs de clés
Public Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
'obtiention des infos sur la clé
If 0 = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0&, lDataBufSize) Then
If (lValueType REG_SZ Or lValueType REG_MULTI_SZ Or lValueType = REG_EXPAND_SZ) Then
'valeur REG_SZ ou multi_SZ
'buffer
strBuf = Space$(lDataBufSize)
'contenu de la clé
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'formatage de la string
RegQueryStringValue = Left$(strBuf, InStr(strBuf, vbNullChar) - 1)
End If
End If
End If
End Function
3 sept. 2006 à 02:38
en effet, en REG_BINARY, tu dit à l'API de stocker les données (lDataBufSize) dans un Entier....
un de mes champs de ma base de registres ressemble à cela :
80 51 01 00 00 00 00 ...
et là, dans un Integer...
3 sept. 2006 à 00:55
c'est rien du tout, c'est juste que le buffer nécessaire doit aussi contenir les chaines de caractères... celles-ci sont donc stockées après le tableau de ENUM_SERVICE_STATUS.
3 sept. 2006 à 00:31
je vois des lstrcpy a des endroit improbables, et qui génèrent des lectures hors sujet, et qui génèrent les crash subis...
lpEnumServiceStatus(i).ServiceStatus.dwCurrentState est un Long.
ce n'est nullement un pointeur vers une chaine de caractères...
c'est directement une valeur exploitable. Le lstrcpy que tu lui fait subir provoque une instabilité de ton application, et des crashs aléatoires.
2 sept. 2006 à 15:38
J'ai hate de voir le projet complet ^^
2 sept. 2006 à 10:51
en effet, si tu regardes
lngStructsNeeded = lngBytesNeeded / Len(lpEnumServiceStatus(0)) + 1
tu as :
lngBytesNeeded / Len(lpEnumServiceStatus(0))
qui renvoie un nombre décimal...
d'autre part, une fois la première enumeration faite, tu en refait une, en ne pécisant pas les memes besoins :
SERVICE_WIN32 Or SERVICE_ADAPTER Or SERVICE_DRIVER Or SERVICE_INTERACTIVE_PROCESS
enfin, je trouve très dangereux de fixer à 250 ton tampon de lecture.
utilises plutot lstrlen
2 sept. 2006 à 09:25
Le plantage après compilation me laisse désarmé car on a aucun message d'erreur.Je me sens incapable de corriger le problème.
Chapeau si tu trouves le remède violent_ken.
Pour faciliter la lecture des cases trop longues, je propose d'ajouter une Sub comme celle-ci par exemple:
Private Sub LV8_Click()
MsgBox LV8.SelectedItem.ListSubItems(8)
End Sub
qui permet de lire confortablement la description du service.
1 sept. 2006 à 23:51
-ligne :
If (lValueType REG_SZ Or lValueType REG_MULTI_SZ Or lValueType = REG_EXPAND_SZ) Then
-pour le service 6, à savoir Aspnet_state chez moi, et pour l'informations "FailureActions"
Planatge radical (quitte brusquement sans erreur) uniquement en code natif.
Reste à savoir pourquoi ?
Je plancherais dessus...lundi (abs ce weekend).
Si quelqu'un trouve une réponse, ou si quelqu'un a un autre problème, ou si quelqu'un n'a pas ce problème (compilation code natif), faîtes moi signe ^^
@+
1 sept. 2006 à 23:36
Mais pas compilé en pseudo code, et pas dans l'IDE de VB...
Je planche dessus...
1 sept. 2006 à 23:10
@+
1 sept. 2006 à 22:40
plus de _Terminate, de _Unload ni de déchargement propre...
c'est une mauvaise habitude de plus à ne pas prendre que de l'utiliser
1 sept. 2006 à 22:18
Concernant la réutilisation du code, il est vrai que modifier ainsi les éléments de la form à partir du module n'est pas génial... j'ai laissé comme çà, étant un morceau de mon projet. Mais je vais reprendre çà.
Pour les Select Case, il est vrai que c'est plus propre, et il est vrai que j'en utilise ailleurs dans le code... mais côté perfs. c'est pas génial :(
Pour le redimensionnement de la fenêtre, je vais évidemment l'inclure dans la mise à jour.
Je vais reprendre tout çà.
Merci pour ce commentaire constructif, @+
1 sept. 2006 à 21:46
L'instruction End est à proscrire absolument
Private Sub cmdEnd_Click()
End
End Sub
Dommage que tu ais fait un Module (donc quelque chose de réutilisable) mais que tu y manipule directement les objets de ta Form.
Un petit Select Case ?
If l SERVICE_STOPPED Then s "Arrêté"
If l SERVICE_START_PENDING Then s "Démarrage..."
If l SERVICE_STOP_PENDING Then s "Arrêt..."
If l SERVICE_RUNNING Then s "Démarré"
If l SERVICE_CONTINUE_PENDING Then s "Service continue is pending"
If l SERVICE_PAUSE_PENDING Then s "Service pause is pending"
If l SERVICE_PAUSED Then s "En pause"
(et en mix fra/eng)
Coté perfs, faut éviter de re-re-re-chercher n fois un objet dans un collection ( .Item(i + 1) ) :
.Item(i + 1).SubItems(7) = RetrieveServiceInfo(sServ, DependOnService)
.Item(i + 1).SubItems(8) = RetrieveServiceInfo(sServ, Description)
.Item(i + 1).SubItems(9) = RetrieveServiceInfo(sServ, DiagnosticsMessageFile)
.Item(i + 1).SubItems(10) = RetrieveServiceInfo(sServ, ErrorControl)
.Item(i + 1).SubItems(11) = RetrieveServiceInfo(sServ, FailureActions)
.Item(i + 1).SubItems(12) = RetrieveServiceInfo(sServ, Group)
.Item(i + 1).SubItems(13) = RetrieveServiceInfo(sServ, ImagePath)
.Item(i + 1).SubItems(14) = RetrieveServiceInfo(sServ, ObjectName)
.Item(i + 1).SubItems(15) = RetrieveServiceInfo(sServ, Start)
.Item(i + 1).SubItems(16) = RetrieveServiceInfo(sServ, Tag)
ce serait sympa que l'on puisse redimensionner la fenêtre (même si je suis conscient que ca n'est qu'une Form de test)
1 sept. 2006 à 21:03
Critiquez avec arguments !
Merci, @+