Стандартную программу с такой функциональностью я в Windows так и не нашёл (хотя искал).
- Код: Выделить всё
Option Explicit
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
bogus(60) As Byte
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Any, ByRef lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, ByRef lpCreationTime As Currency, ByRef lpExitTime As Currency, ByRef lpKernelTime As Currency, ByRef lpUserTime As Currency) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Sub Main()
If Len(Command) Then
Dim si As STARTUPINFO, pi As PROCESS_INFORMATION
si.cb = Len(si)
If CreateProcess(vbNullString, Command, ByVal 0&, ByVal 0&, False, 0, ByVal 0&, vbNullString, si, pi) Then
CloseHandle pi.hThread
WaitForSingleObject pi.hProcess, -1
Dim creat As Currency, exitt As Currency, kern As Currency, user As Currency
GetProcessTimes pi.hProcess, creat, exitt, kern, user
exitt = exitt - creat
' times are in 100ns*10000 intervals = 1ms intervals
MsgBox "real: " & Round(exitt / 1000, 3) & "s" & vbCrLf & _
"user: " & Round(user / 1000, 3) & "s" & vbCrLf & _
"sys: " & Round(kern / 1000, 3) & "s" & vbCrLf
Else
MsgBox "CreateProcess: error #" & Err.LastDllError
End If
Else
MsgBox "usage: time command"
End If
End Sub
