XL 2021 VBA - Process Start Time

[Dudu2]

Bonjour,

Peut-on en VBA trouver le Process Start Time ?

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

 

[Rheeem]

Avec WMI c'est Creationdate et pas StartTime mais je ne sais pas comment convertir vers date ..
Sinon avec windows API

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

 

[nullosse]

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 :

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.

 

[Dudu2]

Merci à vous 2 pour vos réponses.

 

[Dudu2]

@Rheeem,
Peut-on utiliser un ProcessId avec la méthode API ? Trouver un Object Process à partir du ProcessId ?

 

[Dudu2]

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.

'--------------------------------------------
'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

 

[Rheeem]

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

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

 

[Dudu2]

Ok, merci @Rheeem.
J'ai maintenant l'embarras du choix !

Je sais pas d'où vous sortez ces codes qui m'échappent totalement.