Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0768: Ermitteln ob 32- oder 64-Bit Windows

 von 

Beschreibung 

Dieser Code ermittelt, ob ein 32- oder 64-Bit Windows läuft. Da der WOW64-Emulator, der ein Ausführen von 32-Bit Programmen unter einem 64-Bit Windows erlaubt, weiterhin dem Programm die x86-Architektur vorzugeben versucht, muss in diesem Fall die GetNativeSystemInfo-Funktion bemüht werden. Zusätzlich wird hier noch bei einem 64-Bit System zwischen den Plattformen x64 und Itanium unterschieden.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetNativeSystemInfo, GetVersionExA (GetVersionEx)

Download:

Download des Beispielprojektes [2.45 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
Private Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Integer
    wProcessorRevision As Long
End Type

Private Declare Sub GetNativeSystemInfo Lib "kernel32.dll" (ByRef lpSystemInfo As SYSTEM_INFO)

Private Const PROCESSOR_ARCHITECTURE_AMD64 As Integer = 9
Private Const PROCESSOR_ARCHITECTURE_IA64 As Integer = 6
Private Const PROCESSOR_ARCHITECTURE_INTEL As Integer = 0
Private Const PROCESSOR_ARCHITECTURE_UNKNOWN As Integer = &HFFFF

Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type

Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32s As Long = 0

Private Enum OSArchitecture
    OSA_Unknown = 0
    OSA_x86 = 1 '32 bit
    OSA_x64 = 2 '64 bit
    OSA_Itanium = 3 '64 bit
End Enum

Private Function GetOsArchitecture() As OSArchitecture

Dim OSInfo As OSVERSIONINFO
Dim SInfo As SYSTEM_INFO
Dim Version As Long

'OS Plattform und Version auslesen
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
Call GetVersionEx(OSInfo)

'Plattform unterscheiden
Select Case OSInfo.dwPlatformId
    Case VER_PLATFORM_WIN32s
        'win32 layer on win16, veraltet
        GetOsArchitecture = OSA_Unknown
    Case VER_PLATFORM_WIN32_WINDOWS
        'Win9x -> 32bit
        GetOsArchitecture = OSA_x86
    Case VER_PLATFORM_WIN32_NT
        'NT, XP, Server2k3, ...
        
        'Versionskomponenten zu Long zusammensetzen; vereinfacht die Prüfung
        Version = (OSInfo.dwBuildNumber * &H1000) Or OSInfo.dwMajorVersion
        If (Version = 327680) Then '= 5.0 (w2k)?
            'Win 2k -> 32bit
            GetOsArchitecture = OSA_x86
        ElseIf (Version >= 327681) Then '>= 5.1 (XP, Server2k3, ...)?
            '-> GetNativeSystemInfo vorhanden
            
            GetNativeSystemInfo SInfo
            
            'Prozessorarchitektur des OS unterscheiden
            Select Case SInfo.wProcessorArchitecture
                Case PROCESSOR_ARCHITECTURE_AMD64
                    'x64 (AMD Or Intel)
                    GetOsArchitecture = OSA_x64
                Case PROCESSOR_ARCHITECTURE_IA64
                    ' Intel Itanium Processor Family (IPF)
                    GetOsArchitecture = OSA_Itanium
                Case PROCESSOR_ARCHITECTURE_INTEL
                    'x86
                    GetOsArchitecture = OSA_x86
                Case PROCESSOR_ARCHITECTURE_UNKNOWN
                    'unknown
                    GetOsArchitecture = OSA_Unknown
                Case Else
                    GetOsArchitecture = OSA_Unknown
            End Select
            
        End If
        
    Case Else
        
        GetOsArchitecture = OSA_Unknown
    
End Select

End Function

Private Sub Command1_Click()
     
    Select Case GetOsArchitecture()
        Case OSA_Unknown
            MsgBox "unknown OS architecture"
        Case OSA_x86
            MsgBox "x86 architecture (32 bit)"
        Case OSA_x64
            MsgBox "x64 architecture (64 bit)"
        Case OSA_Itanium
            MsgBox "Itanium architecture (64 bit)"
    End Select
    
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.