XL 2021 VBA - Process Start Time

  • Initiateur de la discussion Initiateur de la discussion Dudu2
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Dudu2

XLDnaute Barbatruc
Bonjour,

Peut-on en VBA trouver le Process Start Time ?

VB:
Option Explicit

Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long

Sub a()
    Dim Process As Object

    For Each Process In GetObject("winmgmts:").ExecQuery("Select * from Win32_Process")
        If Process.ProcessId = GetCurrentProcessId Then Exit For
    Next Process
    
    If Not Process Is Nothing Then
        'MsgBox Process.Name
        MsgBox System.Diagnostics.Process.GetProcessById(GetCurrentProcessId).StartTime
    End If
End Sub
 
Avec WMI c'est Creationdate et pas StartTime mais je ne sais pas comment convertir vers date ..
Sinon avec windows API
Code:
Private Declare PtrSafe Function GetProcessTimes Lib "kernel32" (ByVal hProcess As LongPtr, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
Private Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type


Private Sub CommandButton1_Click()
Dim d As FILETIME, st As FILETIME
Dim H As LongPtr, ret As SYSTEMTIME
   H = GetCurrentProcess
   GetProcessTimes H, st, d, d, d
   FileTimeToLocalFileTime st, d
   FileTimeToSystemTime d, ret
   Debug.Print ret.wHour; ret.wMinute; ret.wMilliseconds
End Sub
 
Avec WMI c'est Creationdate et pas StartTime mais je ne sais pas comment convertir vers date ..
Salut,
avec WMI on peut faire comme ceci :
VB:
Option Explicit
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Sub a()
    Dim wmi As Object, res As Object, dtmCreationDate As Object, readableDate As Date
    Set dtmCreationDate = CreateObject("WbemScripting.SWbemDateTime")
    Set wmi = GetObject("winmgmts:root\CIMV2")
    Set res = wmi.ExecQuery("Select * from Win32_Process Where ProcessId = " & _
                 CStr(GetCurrentProcessId()))
        If res.Count = 1 Then
              dtmCreationDate = res.ItemIndex(0).CreationDate
              readableDate = dtmCreationDate.GetVarDate
              Debug.Print readableDate
        End If
End Sub

Nullosse.
 
Dernière édition:
Pour l'instant j'utilise le code de @nullosse car j'ai besoin de classer des Process connus par leur PID par leurs dates de création.
VB:
'--------------------------------------------
'Get Process creation date from its ProcessId
'--------------------------------------------
Private Function GetProcessCreationDateByProcessId(ProcessId As Long) As Date
    Dim Res As Object
    Dim dtmCreationDate As Object
    
    Set dtmCreationDate = CreateObject("WbemScripting.SWbemDateTime")
    Set Res = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process Where ProcessId = " & CStr(ProcessId))
    
    If Res.Count = 1 Then
        dtmCreationDate = Res.ItemIndex(0).CreationDate
        
        'Return value
        GetProcessCreationDateByProcessId = dtmCreationDate.GetVarDate
    End If
End Function
 
Essaie le code suivant , si le but est de trier sans réellement intéressé à la valeur des dates donc pas besoin d'effectuer les conversions par FileTimeToSystemTime et FileTimeToLocalFileTime, remplacer FILETIME par Currency et comparer les valeurs directement

Code:
Private Declare PtrSafe Function GetProcessTimes Lib "kernel32" (ByVal hProcess As LongPtr, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
Private Declare PtrSafe Sub CloseHandle Lib "kernel32" (ByVal aObj As LongPtr)

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
Private Function ProcessStartTime(ByVal Pid As Long) As Date
Const PROCESS_QUERY_LIMITED_INFORMATION = &H1000
Dim D As FILETIME, st As FILETIME
Dim h As LongPtr, r As SYSTEMTIME
   h = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, 0, Pid)
   If h <> 0 Then
      GetProcessTimes h, st, D, D, D
      CloseHandle h
      FileTimeToLocalFileTime st, D
      FileTimeToSystemTime D, r
      ProcessStartTime = DateSerial(r.wYear, r.wMonth, r.wDay) + TimeSerial(r.wHour, r.wMinute, r.wSecond)
   End If
End Function
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
461
Retour