#Samurai
Изучающий
- Регистрация
- 16 Сен 2017
- Сообщения
- 421
- Лучшие ответы
- 0
- Репутация
- 229
Код:
Код:
option explicit
dim oFSO, LogFile_full, LogFile_cur, oShell, cur, ver
ver = "1.2"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
' Make me Admin :) Получаем права Администратора
if WScript.Arguments.Count = 0 then
if not isAdminRights() then
Elevate()
WScript.Quit
end if
end if
cur = oFSO.GetParentFolderName(WScript.ScriptFullName)
LogFile_full = cur & "\ProcessCPU_Average.csv"
LogFile_cur = cur & "\ProcessCPU_Current.csv"
on error resume next
if oFSO.FileExists(LogFile_full) then oFSO.DeleteFile(LogFile_full)
if oFSO.FileExists(LogFile_cur) then oFSO.DeleteFile(LogFile_cur)
if Err.Number <> 0 then msgbox "Ошибка! Закройте, пожалуйста, книги Excel и запустите скрипт еще раз.", vbCritical, "GetCPUUsage v." & ver & " by Dragokas": WScript.Quit 1
on error goto 0
oShell.Popup "Пожалуйста, подождите...", 4, "GetCPUUsage by Dragokas"
CPUTimeToLog
msgbox "Готово." & vblf & "Выложите в теме, где Вам оказывают помощь, файлы:" & vblf & vblf &_
"1. ProcessCPU_Current.csv" & vblf & "2. ProcessCPU_Average.csv" & vblf & vblf &_
"упаковав в архив формата zip.", vbInformation, "GetCPUUsage v." & ver & " by Dragokas"
WScript.Quit
Set oFSO = Nothing: Set oShell = Nothing
Sub CPUTimeToLog()
dim Kernel_t1, User_t1, Total_t1
dim Kernel_t2, User_t2, Total_t2
dim oSCR_t1, oSCR_t2, oSCR_PID, oSCR_path, oSCR_Serv, oSCR_parentPID, oTS, WMI, oProcesses, oProcess, Key
dim Proc_t1, Proc_t2, Delta_Proc, Delta_System, oServices, oService, Service_Name, ParentPID, ParentPath
'PID -> TotalTime
set oSCR_t1 = CreateObject("Scripting.Dictionary")
set oSCR_t2 = CreateObject("Scripting.Dictionary")
'PID -> Name
set oSCR_PID = CreateObject("Scripting.Dictionary")
'PID -> Путь и параметры командной строки
set oSCR_path = CreateObject("Scripting.Dictionary")
'PID -> Service
set oSCR_Serv = CreateObject("Scripting.Dictionary")
'PID -> ParentPID
set oSCR_parentPID = CreateObject("Scripting.Dictionary")
Set WMI = GetObject("winmgmts:\root\cimv2")
Set oServices = WMI.ExecQuery("SELECT * FROM Win32_Service") 'Получаю имена и описания служб -> привязываю к PID (ключ - это PID)
For each oService in oServices
if oSCR_Serv.Exists(oService.ProcessID) then
oSCR_Serv(oService.ProcessID) = oSCR_Serv(oService.ProcessID) & _
oService.Name & " (" & oService.Caption & "), "
else
oSCR_Serv.Add oService.ProcessID, oService.Name & " (" & oService.Caption & "), "
end if
Next
WScript.Sleep(500) ' Нормализация % скачка CPU, вызванного запуском этого скрипта
' 1-я засечка
Set oProcesses = WMI.ExecQuery("SELECT * FROM Win32_Process")
For each oProcess in oProcesses
with oProcess
Kernel_t1 = Kernel_t1 + cdbl(.KernelModeTime)
User_t1 = User_t1 + cdbl(.UserModeTime)
oSCR_t1.Add .ProcessID, cdbl(.KernelModeTime) + cdbl(.UserModeTime)
oSCR_PID.Add .ProcessID, .Caption 'PID -> Name
oSCR_path.Add .ProcessID, .ExecutablePath 'PID -> Path
oSCR_parentPID.Add .ProcessID, .ParentProcessId 'PID -> ParentPID
end with
Next
'Всего времени всех процессов
Total_t1 = Kernel_t1 + User_t1
set oTS = oFSO.CreateTextFile(LogFile_full, true)
oTS.WriteLine "CPU (%);Process Name;PID;Service;Path;ParentPath"
SpecialSortDict oSCR_t1, true 'Сортировка словаря в обратном порядке по % CPU.
For each Key in oSCR_t1.Keys
Proc_t1 = oScr_t1(Key)
if (oSCR_Serv.Exists(Key) and Key <> 0) then Service_Name = oSCR_Serv(Key) else Service_Name = ""
ParentPID = oSCR_parentPID(Key)
if (oSCR_path.Exists(ParentPID) and Key <> 0) then ParentPath = oSCR_path(ParentPID) else ParentPath = ""
oTS.Write round(Proc_t1 / Total_t1 * 100, 2) & ";" 'CPU (%)
oTS.Write oSCR_PID(Key) & ";" 'Process Name
oTS.Write Key & ";" 'PID
oTS.Write Service_Name & ";" 'Service
oTS.Write oScr_path(Key) & ";" 'Path
oTS.Write ParentPath & ";" 'Parent Path
oTS.WriteLine ""
Next
oTS.Close
WScript.Sleep(2000) 'выжидаю 2 сек.
' 2-я засечка
Set oProcesses = WMI.ExecQuery("SELECT * FROM Win32_Process")
For each oProcess in oProcesses
with oProcess
Kernel_t2 = Kernel_t2 + cdbl(.KernelModeTime)
User_t2 = User_t2 + cdbl(.UserModeTime)
oSCR_t2.Add .ProcessID, cdbl(.KernelModeTime) + cdbl(.UserModeTime)
if not oSCR_PID.Exists(.ProcessID) then
oSCR_PID.Add .ProcessID, .Caption 'PID -> Name (если появились новые)
oSCR_path.Add .ProcessID, .ExecutablePath 'PID -> Path (если появились новые)
oSCR_parentPID.Add .ProcessID, .ParentProcessId 'PID -> ParentPID
end if
end with
Next
'Всего времени всех процессов
Total_t2 = Kernel_t2 + User_t2
' Словарь PID -> Дельта CPU:
' Записываю разницу по формуле:
' % нагрузки процесса = Дельта времени процесса / дельта времени системы * 100
Dim oSCR_delta: set oSCR_delta = CreateObject("Scripting.Dictionary")
For each Key in oSCR_t2.Keys
Proc_t1 = oScr_t1(Key)
Proc_t2 = oScr_t2(Key)
Delta_Proc = Proc_t2 - Proc_t1
Delta_System = Total_t2 - Total_t1
oSCR_delta.Add key, round(Delta_Proc / Delta_System * 100, 2)
Next
SpecialSortDict oSCR_delta, true ' Сортировка словаря в обратном порядке по % CPU.
set oTS = oFSO.CreateTextFile(LogFile_cur, true)
oTS.WriteLine "CPU (%);Process Name;PID;Service;Path;ParentPath"
For each Key in oSCR_delta.Keys
if (oSCR_Serv.Exists(Key) and Key <> 0) then Service_Name = oSCR_Serv(Key) else Service_Name = ""
ParentPID = oSCR_parentPID(Key)
if (oSCR_path.Exists(ParentPID) and Key <> 0) then ParentPath = oSCR_path(ParentPID) else ParentPath = ""
oTS.Write oSCR_delta(key) & ";" 'CPU (%)
oTS.Write oSCR_PID(Key) & ";" 'Process Name
oTS.Write Key & ";" 'PID
oTS.Write Service_Name & ";" 'Service
oTS.Write oScr_path(Key) & ";" 'Path
oTS.Write ParentPath & ";" 'ParentPath
oTS.WriteLine ""
Next
oTS.Close
Set oProcess = Nothing: set oProcesses = Nothing: set WMI = Nothing: set oTS = Nothing
Set oSCR_PID = Nothing: set oSCR_t1 = Nothing: set oSCR_t2 = Nothing: set oSCR_path = Nothing
Set oSCR_Serv = Nothing: set oSCR_parentPID = Nothing
End Sub
Sub Elevate()
Dim colOS, oOS, strOSLong, oShellApp
Const DQ = """"
Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery("Select * from Win32_OperatingSystem")
For Each oOS In colOS: strOSLong = oOS.Version: Next
If Left(strOSLong, 1) = "6" and Not isAdminRights Then
Set oShellApp = CreateObject("Shell.Application")
oShellApp.ShellExecute WScript.FullName, DQ & WScript.ScriptFullName & DQ & " " & DQ & "Twice" & DQ, "", "runas", 1
WScript.Quit
End If
set oOS = Nothing: set colOS = Nothing: set oShellApp = Nothing
End Sub
Function isAdminRights()
Dim oReg, strKey, intErrNum, flagAccess
Const KQV = &H1, KSV = &H2, HKCU = &H80000001, HKLM = &H80000002
Set oReg = GetObject("winmgmts:root\default:StdRegProv")
strKey = "System\CurrentControlSet\Control\Session Manager"
intErrNum = oReg.CheckAccess(HKLM, strKey, KQV + KSV, flagAccess)
isAdminRights = flagAccess
Set oReg = Nothing
End Function
'Сортировка словаря методом вставок -> исходный словарь реконструируется
Sub SpecialSortDict(inDict, Reverse)
Dim arrPos: arrPos = inDict.keys 'Инициализация массива позиций ключей словаря
Dim arrTemp: arrTemp = inDict.Items 'Виртуализация значений словаря
Dim i, j, xItem
For i = 1 To UBound(arrTemp) 'Сортировка методом вставок
For j = i To 1 Step -1
If arrTemp(j) < arrTemp(j - 1) Then
xItem = arrTemp(j) 'Обмен значений
arrTemp(j) = arrTemp(j - 1)
arrTemp(j - 1) = xItem
xItem = arrPos(j) 'Обмен ключей
arrPos(j) = arrPos(j - 1)
arrPos(j - 1) = xItem
Else
Exit For
End If
Next
Next
dim iStart, iEnd, iStep
if Reverse then iStep = -1: iStart = UBound(arrPos): iEnd = 0 else iStep = 1: iStart = 0: iEnd = UBound(arrPos)
Dim virtDict: Set virtDict = CreateObject("Scripting.Dictionary")
For i = iStart To iEnd step iStep 'Расставляем значения в виртуальный словарь согласно массива ключей
virtDict.Add arrPos(i), inDict(arrPos(i))
Next
Set inDict = virtDict
End Sub
Последнее редактирование: