[AccessD] A2K:Determine OS and version via VBA

Hi Darren

> I used to have a little code jewel from the list tucked away in my own
> personal little archive that would allow me to determine the OS in VBA- But
> alas since the death of the laptop my personal stash has gone So....Anyone
> got any code to determine the OS and version?

We use this module:

<code>

Option Compare Database
Option Explicit

'                           Major     Minor
' OS              Platform  Version   Version  Build
'
' Windows 95      1         4          0
' Windows 98      1         4         10       1998
' Windows 98SE    1         4         10       2222
' Windows ME      1         4         90       3000
' NT 3.51         2         3         51
' NT              2         4          0       1381
' 2000            2         5          0
' XP              2         5          1       2600
' Server 2003     2         5          2

' Code based on MS API documentation.
' 2004-07-02. Assembled by Cactus Data ApS, CPH.
  
  Private Const VER_PLATFORM_WIN32s         As Long = 0 ' Win32s on Windows 3.1x.
  Private Const VER_PLATFORM_WIN32_WINDOWS  As Long = 1 ' Windows 95, Windows 98, Windows ME.
  Private Const VER_PLATFORM_WIN32_NT       As Long = 2 ' Windows NT, Windows 2000, Windows XP, Windows Server 2003.
  
  Private Const clngCSDVersion              As Long = 128

  Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * clngCSDVersion
  End Type
  
  Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
    ByRef lpVersionInformation As OSVERSIONINFO) _
    As Long

Public Function GetVersion() As String

' Retrieves version of current Windows OS.
' Returns version as full string.
'
' 2004-07-02. Cactus Data ApS, CPH.

  Dim OSV         As OSVERSIONINFO
  
  Dim strVersion  As String
    
  OSV.dwOSVersionInfoSize = Len(OSV)
  OSV.szCSDVersion = Space$(clngCSDVersion)
  GetVersionEx OSV
  With OSV
    ' Service Pack info string.
    Debug.Print .szCSDVersion
    Select Case .dwPlatformId
      Case VER_PLATFORM_WIN32s          ' Win32s on Windows 3.1x.
        strVersion = "Windows 3.1"
      Case VER_PLATFORM_WIN32_WINDOWS   ' Windows 95, Windows 98,
        Select Case .dwMinorVersion     ' Windows ME.
          Case 0
            strVersion = "Windows 95"
          Case 10
            If (.dwBuildNumber And &HFFFF&) = 2222 Then
              strVersion = "Windows 98SE"
            Else
              strVersion = "Windows 98"
            End If
          Case 90
            strVersion = "Windows ME"
        End Select
      Case VER_PLATFORM_WIN32_NT        ' Windows NT, Windows 2000, Windows XP,
        Select Case .dwMajorVersion     ' Windows Server 2003.
          Case 3
            strVersion = "Windows NT 3.51"
          Case 4
            strVersion = "Windows NT 4.0"
          Case 5
            Select Case .dwMinorVersion
              Case 0
                strVersion = "Windows 2000"
              Case 1
                strVersion = "Windows XP"
              Case 2
                strVersion = "Windows Server 2003"
            End Select
        End Select
      Case Else
        strVersion = "Unknown"
    End Select
  End With
  
  GetVersion = strVersion
  
End Function

Public Function IsWinXP() As Boolean

' Checks current Windows OS.
' Returns True if OS is Win XP or Server 2003.
'
' 2004-07-07. Cactus Data ApS, CPH.

  Dim OSV         As OSVERSIONINFO
  
  Dim booVersion  As Boolean
    
  OSV.dwOSVersionInfoSize = Len(OSV)
  GetVersionEx OSV
  With OSV
    Select Case .dwPlatformId
      Case VER_PLATFORM_WIN32_NT        ' Windows NT, Windows 2000, Windows XP,
        Select Case .dwMajorVersion     ' Windows Server 2003.
          Case 5
            Select Case .dwMinorVersion
              Case 0
                ' strVersion = "Windows 2000"
              Case 1
                ' strVersion = "Windows XP"
                booVersion = True
              Case 2
                ' strVersion = "Windows Server 2003"
                booVersion = True
            End Select
        End Select
    End Select
  End With
  
  IsWinXP = booVersion
  
End Function

</code>

Have fun!

/gustav