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