Как получить текущее использование процессора и оперативной памяти в VB 6? - PullRequest
0 голосов
/ 10 сентября 2009

как получить использование процессора и памяти в коде VB 6? Спасибо!

Ответы [ 3 ]

3 голосов
/ 10 сентября 2009

Определение загрузки процессора на текущей машине

Объявления

Option Explicit
' Note that if you declare the lpData parameter as String, you
' must pass it By Value.
 Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
 Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
 As String, ByVal lpReserved As Long, lpType As Long, lpData As _
 Any, lpcbData As Long) As Long

 Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
 "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
 ByVal ulOptions As Long, ByVal samDesired As Long, _
 phkResult As Long) As Long

 Private Declare Function RegCloseKey Lib "advapi32.dll" _
 (ByVal hKey As Long) As Long

 Private Const KEY_QUERY_VALUE = &H1

 Private Const HKEY_DYN_DATA As Long = &H80000006
 Private Const STAT_DATA = "PerfStats\StatData"
 Private Const CPU_USE = "KERNEL\CPUUsage"

код

Public Function CPU_Usage_Percent() As Long
On Error GoTo errorhandler:
Dim lResult As Long
Dim lData As Long
Dim lType As Long
Dim hKey As Long


lResult = RegOpenKeyEx(HKEY_DYN_DATA, STAT_DATA, _
   0, KEY_QUERY_VALUE, hKey)

If lResult = 0 Then
    lResult = RegQueryValueEx(hKey, CPU_USE, 0, _
     lType, lData, 4)
    If lResult = 0 Then
        CPU_Usage_Percent = lData
        lResult = RegCloseKey(hKey)
    End If
End If
Exit Function

 errorhandler:
     On Error Resume Next
     RegCloseKey hKey
     Exit Function
     End Function
1 голос
/ 11 сентября 2009

Вот как получить информацию о вашей оперативной памяти:

Вы можете взять приведенный ниже код и просто вставить его в форму. Я оставляю вам обработку ошибок, так как ожидаю, что вы захотите просто использовать это в качестве примера. Существует также функция для преобразования 64-разрядного целого числа в двойное число VB, а также функция для форматирования числа в КБ, МБ и ГБ.

Private Declare Sub GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUSEX)

Private Type INT64
   LoPart As Long
   HiPart As Long
End Type

Private Type MEMORYSTATUSEX
   dwLength As Long
   dwMemoryLoad As Long
   ulTotalPhys As INT64
   ulAvailPhys As INT64
   ulTotalPageFile As INT64
   ulAvailPageFile As INT64
   ulTotalVirtual As INT64
   ulAvailVirtual As INT64
   ulAvailExtendedVirtual As INT64
End Type

Private Sub Form_Load()

   Me.AutoRedraw = True
   Call PrintRamInformation

End Sub

Private Sub PrintRamInformation()
   Dim udtMemStatEx As MEMORYSTATUSEX

   Me.Cls

   udtMemStatEx.dwLength = Len(udtMemStatEx)
   Call GlobalMemoryStatusEx(udtMemStatEx)

   Me.Print "Total physical memory" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulTotalPhys.LoPart, udtMemStatEx.ulTotalPhys.HiPart)) & " (" & Round(CLargeInt(udtMemStatEx.ulAvailPhys.LoPart, udtMemStatEx.ulAvailPhys.HiPart) / (CLargeInt(udtMemStatEx.ulTotalPhys.LoPart, udtMemStatEx.ulTotalPhys.HiPart)) * 100) & "% Free)"
   Me.Print "Available physical memory" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulAvailPhys.LoPart, udtMemStatEx.ulAvailPhys.HiPart))
   Me.Print "Total virtual memory" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulTotalVirtual.LoPart, udtMemStatEx.ulTotalVirtual.HiPart))
   Me.Print "Available virtual memory" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulAvailVirtual.LoPart, udtMemStatEx.ulAvailVirtual.HiPart))
   Me.Print "Total page file" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulTotalPageFile.LoPart, udtMemStatEx.ulTotalPageFile.HiPart))
   Me.Print "Available page file" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulAvailPageFile.LoPart, udtMemStatEx.ulAvailPageFile.HiPart))
   Me.Print "Available extended page file" + vbTab + NumberInKB(CLargeInt(udtMemStatEx.ulAvailExtendedVirtual.LoPart, udtMemStatEx.ulAvailExtendedVirtual.HiPart))
   Me.Print "Memory Load" + vbTab + CStr(udtMemStatEx.dwMemoryLoad) + "%"

End Sub

'This function converts the LARGE_INTEGER data type to a double
Private Function CLargeInt(Lo As Long, Hi As Long) As Double
   Dim dblLo As Double
   Dim dblHi As Double

   If Lo < 0 Then
      dblLo = 2 ^ 32 + Lo
   Else
      dblLo = Lo
   End If

   If Hi < 0 Then
      dblHi = 2 ^ 32 + Hi
   Else
      dblHi = Hi
   End If

   CLargeInt = dblLo + dblHi * 2 ^ 32

End Function

Public Function NumberInKB(ByVal vNumber As Currency) As String
   Dim strReturn As String

   Select Case vNumber
      Case Is < 1024 ^ 1
         strReturn = CStr(vNumber) & " bytes"

      Case Is < 1024 ^ 2
         strReturn = CStr(Round(vNumber / 1024, 1)) & " KB"

      Case Is < 1024 ^ 3
         strReturn = CStr(Round(vNumber / 1024 ^ 2, 2)) & " MB"

      Case Is < 1024 ^ 4
         strReturn = CStr(Round(vNumber / 1024 ^ 3, 2)) & " GB"
   End Select

   NumberInKB = strReturn

End Function
1 голос
/ 10 сентября 2009
...