Hallo, ich habe ein Makro gefunden im Internet, womit man den Physikalischen und Virtuellen Speicher auslesen kann.
Geht bei meinem alten PC prima, der hat 2 GB. Bei meinem neuen zeigt er -1 an. Der hat 16 GB physikalisch und virtuell 32 GB.
Gibt es ne Möglichkeit auch für schnelle Rechner es anzeigen zu lassen?
Option Explicit
'© 2002, Ralf Nebelo
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As typMemoryStatus)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Type SYSTEM_INFO
intProcessorArchitecture As Integer
intReserved As Integer
lngPageSize As Long
lngMinimumApplicationAddress As Long
lngMaximumApplicationAddress As Long
lngActiveProcessorMask As Long
lngNumberOrfProcessors As Long
lngProcessorType As Long
lngAllocationGranularity As Long
intProcessorLevel As Integer
intProcessorRevision As Integer
End Type
Private Type typMemoryStatus
lngLength As Long
lngMemoryLoad As Long
lngTotalPhys As Long
lngAvailPhys As Long
lngTotalPageFile As Long
lngAvailPageFile As Long
lngTotalVirtual As Long
lngAvailVirtual As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
'******************************************************************
'CPU-Infos
'******************************************************************
Public Function HolCPUArchitektur() As String
Dim udtSysInfo As SYSTEM_INFO
Dim strTmp As String
Call GetSystemInfo(udtSysInfo)
strTmp = udtSysInfo.intProcessorArchitecture
If strTmp = 0 Then
HolCPUArchitektur = "Intel"
ElseIf strTmp = 1 Then
HolCPUArchitektur = "MIPS"
ElseIf strTmp = 2 Then
HolCPUArchitektur = "ALPHA"
ElseIf strTmp = 3 Then
HolCPUArchitektur = "PPC"
Else
HolCPUArchitektur = "Unbekannt"
End If
End Function
Public Function HolCPUAnzahl() As Long
Dim udtSysInfo As SYSTEM_INFO
Call GetSystemInfo(udtSysInfo)
HolCPUAnzahl = udtSysInfo.lngNumberOrfProcessors
End Function
Public Function HolCPUTyp() As Long
Dim udtSysInfo As SYSTEM_INFO
Call GetSystemInfo(udtSysInfo)
HolCPUTyp = udtSysInfo.lngProcessorType
End Function
Public Function HolCPURevision() As Long
Dim udtSysInfo As SYSTEM_INFO
Call GetSystemInfo(udtSysInfo)
HolCPURevision = udtSysInfo.intProcessorRevision
End Function
'******************************************************************
'Arbeitsspeicher-Infos
'******************************************************************
Public Function HolPhysSpeicherTotal() As Long
Dim udtMemInfo As typMemoryStatus
udtMemInfo.lngLength = Len(udtMemInfo)
Call GlobalMemoryStatus(udtMemInfo)
HolPhysSpeicherTotal = udtMemInfo.lngTotalPhys
End Function
Public Function HolPhysSpeicherFrei() As Long
Dim udtMemInfo As typMemoryStatus
udtMemInfo.lngLength = Len(udtMemInfo)
Call GlobalMemoryStatus(udtMemInfo)
HolPhysSpeicherFrei = udtMemInfo.lngAvailPhys
End Function
Public Function HolPhysSpeicherAusnutzung() As Long
Dim udtMemInfo As typMemoryStatus
udtMemInfo.lngLength = Len(udtMemInfo)
Call GlobalMemoryStatus(udtMemInfo)
HolPhysSpeicherAusnutzung = udtMemInfo.lngMemoryLoad
End Function
Public Function HolVirtSpeicherTotal() As Long
Dim udtMemInfo As typMemoryStatus
udtMemInfo.lngLength = Len(udtMemInfo)
Call GlobalMemoryStatus(udtMemInfo)
HolVirtSpeicherTotal = udtMemInfo.lngTotalVirtual
End Function
Public Function HolVirtSpeicherFrei() As Long
Dim udtMemInfo As typMemoryStatus
udtMemInfo.lngLength = Len(udtMemInfo)
Call GlobalMemoryStatus(udtMemInfo)
HolVirtSpeicherFrei = udtMemInfo.lngAvailVirtual
End Function
'******************************************************************
'Bildschirm-Infos
'******************************************************************
Public Function HolAuflösungX() As Long
HolAuflösungX = GetSystemMetrics(0)
End Function
Public Function HolAuflösungY() As Long
HolAuflösungY = GetSystemMetrics(1)
End Function
Public Function IstSchonerAktiv() As Boolean
Dim lngRWert As Long
Call SystemParametersInfo(16, 0, lngRWert, 0)
IstSchonerAktiv = CBool(lngRWert)
End Function
'******************************************************************
'Netzwerk-Infos
'******************************************************************
Public Function IstNetzwerkVorhanden() As Boolean
IstNetzwerkVorhanden = CBool(GetSystemMetrics(63) And 1)
End Function
Public Function HolComputerName() As String
Dim strPuffer As String
Dim lngLänge As Long
strPuffer = Space(16)
lngLänge = Len(strPuffer)
If CBool(GetComputerName(strPuffer, lngLänge)) Then
HolComputerName = Left(strPuffer, lngLänge)
End If
End Function
Public Function HolBenutzerName() As String
Dim strPuffer As String
Dim lngLänge As Long
strPuffer = Space(255)
lngLänge = Len(strPuffer)
If CBool(GetUserName(strPuffer, lngLänge)) Then
HolBenutzerName = Left(strPuffer, lngLänge - 1)
End If
End Function
Public Function HolUNCName(strLaufwerk As String) As String
Dim strPuffer As String
Dim lngLänge As Long
strPuffer = Space(255)
lngLänge = Len(strPuffer)
If WNetGetConnection(strLaufwerk, strPuffer, lngLänge) = 0 Then
HolUNCName = Left(strPuffer, lngLänge - 1)
End If
End Function
Public Function HolWindowsVersion() As String
HolWindowsVersion = Application.OperatingSystem
End Function
Danke & Gruß
Michi
|