System/Win32/Info/Version.hsc
{-# LANGUAGE CPP #-}
{- |
Module : System.Win32.Info.Version
Copyright : 2013 shelarcy
License : BSD-style
Maintainer : shelarcy@gmail.com
Stability : Provisional
Portability : Non-portable (Win32 API)
Version information about your computer.
-}
module System.Win32.Info.Version
( -- * Version Info
OSVERSIONINFOEX(..), POSVERSIONINFOEX, LPOSVERSIONINFOEX
, ProductType(..)
, getVersionEx, c_GetVersionEx
-- * Verify OS version
, isVistaOrLater, is7OrLater
) where
import Foreign.Ptr ( Ptr, plusPtr )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Storable ( Storable(..) )
import System.Win32.String ( withTString, peekTString )
import System.Win32.Types ( BOOL, BYTE, failIfFalse_ )
import System.Win32.Word ( WORD, DWORD )
#include <windows.h>
#include "alignment.h"
##include "windows_cconv.h"
----------------------------------------------------------------
-- Version Info
----------------------------------------------------------------
getVersionEx :: IO OSVERSIONINFOEX
getVersionEx =
alloca $ \buf -> do
(#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf
$ sizeOf (undefined::OSVERSIONINFOEX)
failIfFalse_ "GetVersionEx"
$ c_GetVersionEx buf
peek buf
data ProductType = VerUnknow BYTE | VerNTWorkStation | VerNTDomainControler | VerNTServer
deriving (Show,Eq)
instance Storable ProductType where
sizeOf _ = sizeOf (undefined::BYTE)
alignment _ = alignment (undefined::BYTE)
poke buf v = pokeByteOff buf 0 $ case v of
VerUnknow w -> w
VerNTWorkStation -> #const VER_NT_WORKSTATION
VerNTDomainControler -> #const VER_NT_DOMAIN_CONTROLLER
VerNTServer -> #const VER_NT_SERVER
peek buf = do
v <- peekByteOff buf 0
return $ case v of
(#const VER_NT_WORKSTATION) -> VerNTWorkStation
(#const VER_NT_DOMAIN_CONTROLLER) -> VerNTDomainControler
(#const VER_NT_SERVER) -> VerNTServer
w -> VerUnknow w
type POSVERSIONINFOEX = Ptr OSVERSIONINFOEX
type LPOSVERSIONINFOEX = Ptr OSVERSIONINFOEX
data OSVERSIONINFOEX = OSVERSIONINFOEX
{ dwMajorVersion :: DWORD
, dwMinorVersion :: DWORD
, dwBuildNumber :: DWORD
, dwPlatformId :: DWORD
, szCSDVersion :: String
, wServicePackMajor :: WORD
, wServicePackMinor :: WORD
, wSuiteMask :: WORD
, wProductType :: ProductType
} deriving Show
instance Storable OSVERSIONINFOEX where
sizeOf = const #{size struct _OSVERSIONINFOEXW}
alignment _ = #alignment OSVERSIONINFOEX
poke buf info = do
(#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf (sizeOf info)
(#poke OSVERSIONINFOEXW, dwMajorVersion) buf (dwMajorVersion info)
(#poke OSVERSIONINFOEXW, dwMinorVersion) buf (dwMinorVersion info)
(#poke OSVERSIONINFOEXW, dwBuildNumber) buf (dwBuildNumber info)
(#poke OSVERSIONINFOEXW, dwPlatformId) buf (dwPlatformId info)
withTString (szCSDVersion info) $ \szCSDVersion' ->
(#poke OSVERSIONINFOEXW, szCSDVersion) buf szCSDVersion'
(#poke OSVERSIONINFOEXW, wServicePackMajor) buf (wServicePackMajor info)
(#poke OSVERSIONINFOEXW, wServicePackMinor) buf (wServicePackMinor info)
(#poke OSVERSIONINFOEXW, wSuiteMask) buf (wSuiteMask info)
(#poke OSVERSIONINFOEXW, wProductType) buf (wProductType info)
(#poke OSVERSIONINFOEXW, wReserved) buf (0::BYTE)
peek buf = do
majorVersion <- (#peek OSVERSIONINFOEXW, dwMajorVersion) buf
minorVersion <- (#peek OSVERSIONINFOEXW, dwMinorVersion) buf
buildNumber <- (#peek OSVERSIONINFOEXW, dwBuildNumber) buf
platformId <- (#peek OSVERSIONINFOEXW, dwPlatformId) buf
cSDVersion <- peekTString $ (#ptr OSVERSIONINFOEXW, szCSDVersion) buf
servicePackMajor <- (#peek OSVERSIONINFOEXW, wServicePackMajor) buf
servicePackMinor <- (#peek OSVERSIONINFOEXW, wServicePackMinor) buf
suiteMask <- (#peek OSVERSIONINFOEXW, wSuiteMask) buf
productType <- (#peek OSVERSIONINFOEXW, wProductType) buf
return $ OSVERSIONINFOEX majorVersion minorVersion
buildNumber platformId cSDVersion
servicePackMajor servicePackMinor
suiteMask productType
foreign import WINDOWS_CCONV unsafe "windows.h GetVersionExW"
c_GetVersionEx :: LPOSVERSIONINFOEX -> IO BOOL
----------------------------------------------------------------
-- Verify OS version
----------------------------------------------------------------
-- See: http://msdn.microsoft.com/en-us/library/windows/desktop/ms724833(v=vs.85).aspx
isVistaOrLater, is7OrLater :: IO Bool
isVistaOrLater = do
ver <- getVersionEx
return $ 6 <= dwMajorVersion ver
is7OrLater = do
ver <- getVersionEx
return $ 6 <= dwMajorVersion ver
&& 1 <= dwMinorVersion ver
{-
We don't use VerifyVersionInfo function to above functions.
Because VerifyVersionInfo is more difficult than GetVersionEx and accessing field in Haskell.
-- | See: http://support.microsoft.com/kb/225013/
-- http://msdn.microsoft.com/en-us/library/windows/desktop/ms725491(v=vs.85).aspx
bIsWindowsVersionOK :: DWORD -> DWORD -> WORD -> IO BOOL
bIsWindowsVersionOK dwMajor dwMinor dwSPMajor =
alloca $ \buf -> do
zeroMemory buf
(#{size OSVERSIONINFOEXW}::DWORD)
(#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf
(#{size OSVERSIONINFOEXW}::DWORD)
(#poke OSVERSIONINFOEXW, dwMajorVersion) buf dwMajor
(#poke OSVERSIONINFOEXW, dwMinorVersion) buf dwMinor
(#poke OSVERSIONINFOEXW, wServicePackMajor) buf dwSPMajor
-- Set up the condition mask.
let dwlConditionMask = 0
flag = #const VER_MAJORVERSION
.|. #const VER_MINORVERSION
.|. #const VER_SERVICEPACKMAJOR
dwlConditionMask' <- vER_SET_CONDITION dwlConditionMask #{const VER_MAJORVERSION} #{const VER_GREATER_EQUAL}
dwlConditionMask'' <- vER_SET_CONDITION dwlConditionMask' #{const VER_MINORVERSION} #{const VER_MINORVERSION}
dwlConditionMask''' <- vER_SET_CONDITION dwlConditionMask'' #{const VER_SERVICEPACKMAJOR} #{const VER_SERVICEPACKMAJOR}
verifyVersionInfo buf flag dwlConditionMask'''
type ULONGLONG = DWORDLONG
foreign import capi unsafe "windows.h VER_SET_CONDITION"
vER_SET_CONDITION :: ULONGLONG -> DWORD -> BYTE -> IO ULONGLONG
foreign import WINDOWS_CCONV unsafe "windows.h VerifyVersionInfoW"
verifyVersionInfo :: LPOSVERSIONINFOEX -> DWORD -> DWORDLONG -> IO BOOL
-}