VB and VBA Users Source Code: Obtaining information about the operating system
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Obtaining information about the operating system
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, January 17, 2001
Hits:
662
Category:
Windows API
Article:
Below is a function which returns a type containing information on the operating system. Option Explicit Private Const VER_PLATFORM_WIN32s = 0, VER_PLATFORM_WIN32_WINDOWS = 1, VER_PLATFORM_WIN32_NT = 2 Private Type OSVERSIONINFO OSVSize As Long dwVerMajor As Long dwVerMinor As Long dwBuildNumber As Long PlatformID As Long szCSDVersion As String * 128 End Type Public Type tOperatingInfo BuildNo As String PlatformID As Long VersionName As String VersionNo As String ServicePack As String End Type Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 'Purpose : Determine information about the operating system 'Inputs : N/A 'Outputs : A type containing information on the operating system. 'Author : Andrew Baker 'Date : 17/01/2001 12:37 'Notes : 'Revisions : 'Assumptions : Public Function WinVersionInfo() As tOperatingInfo Dim tOSVer As OSVERSIONINFO Dim lPos As Integer Dim sVer As String, sBuild As String On Error Resume Next tOSVer.OSVSize = Len(tOSVer) If GetVersionEx(tOSVer) = 1 Then WinVersionInfo.PlatformID = tOSVer.PlatformID Select Case tOSVer.PlatformID Case VER_PLATFORM_WIN32s WinVersionInfo.VersionName = "Win32s" Case VER_PLATFORM_WIN32_NT If tOSVer.dwVerMajor = 5 Then If tOSVer.dwVerMinor = 0 Then WinVersionInfo.VersionName = "Windows 2000" Else WinVersionInfo.VersionName = "Windows XP" End If Else WinVersionInfo.VersionName = "Windows NT" End If Case VER_PLATFORM_WIN32_WINDOWS 'Determine which version of windows Select Case tOSVer.dwVerMinor Case 0 WinVersionInfo.VersionName = "Windows 95" Case 90 WinVersionInfo.VersionName = "Windows ME" Case Else WinVersionInfo.VersionName = "Windows 98" End Select End Select 'Get version number WinVersionInfo.VersionNo = tOSVer.dwVerMajor & "." & tOSVer.dwVerMinor 'Get build WinVersionInfo.BuildNo = (tOSVer.dwBuildNumber And &HFFFF) 'Get the service pack. lPos = InStr(tOSVer.szCSDVersion, Chr$(0)) If lPos Then WinVersionInfo.ServicePack = Left$(tOSVer.szCSDVersion, lPos - 1) End If End If On Error GoTo 0 End Function 'Demonstration routine Sub Test() With WinVersionInfo Debug.Print .BuildNo Debug.Print .PlatformID Debug.Print .ServicePack Debug.Print .VersionName Debug.Print .VersionNo End With End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
