1{-# LANGUAGE CPP #-} 2{- | 3 Module : System.Win32.Info.Version 4 Copyright : 2013 shelarcy 5 License : BSD-style 6 7 Maintainer : shelarcy@gmail.com 8 Stability : Provisional 9 Portability : Non-portable (Win32 API) 10 11 Version information about your computer. 12-} 13module System.Win32.Info.Version 14 ( -- * Version Info 15 OSVERSIONINFOEX(..), POSVERSIONINFOEX, LPOSVERSIONINFOEX 16 , ProductType(..) 17 , getVersionEx, c_GetVersionEx 18 19 -- * Verify OS version 20 , isVistaOrLater, is7OrLater 21 ) where 22import Foreign.Ptr ( Ptr, plusPtr ) 23import Foreign.Marshal.Alloc ( alloca ) 24import Foreign.Storable ( Storable(..) ) 25import System.Win32.String ( withTString, peekTString ) 26import System.Win32.Types ( BOOL, BYTE, failIfFalse_ ) 27import System.Win32.Word ( WORD, DWORD ) 28 29#include <windows.h> 30#include "alignment.h" 31##include "windows_cconv.h" 32 33---------------------------------------------------------------- 34-- Version Info 35---------------------------------------------------------------- 36getVersionEx :: IO OSVERSIONINFOEX 37getVersionEx = 38 alloca $ \buf -> do 39 (#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf 40 $ sizeOf (undefined::OSVERSIONINFOEX) 41 failIfFalse_ "GetVersionEx" 42 $ c_GetVersionEx buf 43 peek buf 44 45data ProductType = VerUnknow BYTE | VerNTWorkStation | VerNTDomainControler | VerNTServer 46 deriving (Show,Eq) 47 48instance Storable ProductType where 49 sizeOf _ = sizeOf (undefined::BYTE) 50 alignment _ = alignment (undefined::BYTE) 51 poke buf v = pokeByteOff buf 0 $ case v of 52 VerUnknow w -> w 53 VerNTWorkStation -> #const VER_NT_WORKSTATION 54 VerNTDomainControler -> #const VER_NT_DOMAIN_CONTROLLER 55 VerNTServer -> #const VER_NT_SERVER 56 peek buf = do 57 v <- peekByteOff buf 0 58 return $ case v of 59 (#const VER_NT_WORKSTATION) -> VerNTWorkStation 60 (#const VER_NT_DOMAIN_CONTROLLER) -> VerNTDomainControler 61 (#const VER_NT_SERVER) -> VerNTServer 62 w -> VerUnknow w 63 64type POSVERSIONINFOEX = Ptr OSVERSIONINFOEX 65type LPOSVERSIONINFOEX = Ptr OSVERSIONINFOEX 66 67data OSVERSIONINFOEX = OSVERSIONINFOEX 68 { dwMajorVersion :: DWORD 69 , dwMinorVersion :: DWORD 70 , dwBuildNumber :: DWORD 71 , dwPlatformId :: DWORD 72 , szCSDVersion :: String 73 , wServicePackMajor :: WORD 74 , wServicePackMinor :: WORD 75 , wSuiteMask :: WORD 76 , wProductType :: ProductType 77 } deriving Show 78 79instance Storable OSVERSIONINFOEX where 80 sizeOf = const #{size struct _OSVERSIONINFOEXW} 81 alignment _ = #alignment OSVERSIONINFOEX 82 poke buf info = do 83 (#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf (sizeOf info) 84 (#poke OSVERSIONINFOEXW, dwMajorVersion) buf (dwMajorVersion info) 85 (#poke OSVERSIONINFOEXW, dwMinorVersion) buf (dwMinorVersion info) 86 (#poke OSVERSIONINFOEXW, dwBuildNumber) buf (dwBuildNumber info) 87 (#poke OSVERSIONINFOEXW, dwPlatformId) buf (dwPlatformId info) 88 withTString (szCSDVersion info) $ \szCSDVersion' -> 89 (#poke OSVERSIONINFOEXW, szCSDVersion) buf szCSDVersion' 90 (#poke OSVERSIONINFOEXW, wServicePackMajor) buf (wServicePackMajor info) 91 (#poke OSVERSIONINFOEXW, wServicePackMinor) buf (wServicePackMinor info) 92 (#poke OSVERSIONINFOEXW, wSuiteMask) buf (wSuiteMask info) 93 (#poke OSVERSIONINFOEXW, wProductType) buf (wProductType info) 94 (#poke OSVERSIONINFOEXW, wReserved) buf (0::BYTE) 95 96 peek buf = do 97 majorVersion <- (#peek OSVERSIONINFOEXW, dwMajorVersion) buf 98 minorVersion <- (#peek OSVERSIONINFOEXW, dwMinorVersion) buf 99 buildNumber <- (#peek OSVERSIONINFOEXW, dwBuildNumber) buf 100 platformId <- (#peek OSVERSIONINFOEXW, dwPlatformId) buf 101 cSDVersion <- peekTString $ (#ptr OSVERSIONINFOEXW, szCSDVersion) buf 102 servicePackMajor <- (#peek OSVERSIONINFOEXW, wServicePackMajor) buf 103 servicePackMinor <- (#peek OSVERSIONINFOEXW, wServicePackMinor) buf 104 suiteMask <- (#peek OSVERSIONINFOEXW, wSuiteMask) buf 105 productType <- (#peek OSVERSIONINFOEXW, wProductType) buf 106 return $ OSVERSIONINFOEX majorVersion minorVersion 107 buildNumber platformId cSDVersion 108 servicePackMajor servicePackMinor 109 suiteMask productType 110 111foreign import WINDOWS_CCONV unsafe "windows.h GetVersionExW" 112 c_GetVersionEx :: LPOSVERSIONINFOEX -> IO BOOL 113 114---------------------------------------------------------------- 115-- Verify OS version 116---------------------------------------------------------------- 117-- See: http://msdn.microsoft.com/en-us/library/windows/desktop/ms724833(v=vs.85).aspx 118 119isVistaOrLater, is7OrLater :: IO Bool 120isVistaOrLater = do 121 ver <- getVersionEx 122 return $ 6 <= dwMajorVersion ver 123 124is7OrLater = do 125 ver <- getVersionEx 126 return $ 6 <= dwMajorVersion ver 127 && 1 <= dwMinorVersion ver 128 129{- 130We don't use VerifyVersionInfo function to above functions. 131 132Because VerifyVersionInfo is more difficult than GetVersionEx and accessing field in Haskell. 133 134-- | See: http://support.microsoft.com/kb/225013/ 135-- http://msdn.microsoft.com/en-us/library/windows/desktop/ms725491(v=vs.85).aspx 136 137bIsWindowsVersionOK :: DWORD -> DWORD -> WORD -> IO BOOL 138bIsWindowsVersionOK dwMajor dwMinor dwSPMajor = 139 alloca $ \buf -> do 140 zeroMemory buf 141 (#{size OSVERSIONINFOEXW}::DWORD) 142 (#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf 143 (#{size OSVERSIONINFOEXW}::DWORD) 144 (#poke OSVERSIONINFOEXW, dwMajorVersion) buf dwMajor 145 (#poke OSVERSIONINFOEXW, dwMinorVersion) buf dwMinor 146 (#poke OSVERSIONINFOEXW, wServicePackMajor) buf dwSPMajor 147 -- Set up the condition mask. 148 let dwlConditionMask = 0 149 flag = #const VER_MAJORVERSION 150 .|. #const VER_MINORVERSION 151 .|. #const VER_SERVICEPACKMAJOR 152 dwlConditionMask' <- vER_SET_CONDITION dwlConditionMask #{const VER_MAJORVERSION} #{const VER_GREATER_EQUAL} 153 dwlConditionMask'' <- vER_SET_CONDITION dwlConditionMask' #{const VER_MINORVERSION} #{const VER_MINORVERSION} 154 dwlConditionMask''' <- vER_SET_CONDITION dwlConditionMask'' #{const VER_SERVICEPACKMAJOR} #{const VER_SERVICEPACKMAJOR} 155 verifyVersionInfo buf flag dwlConditionMask''' 156 157type ULONGLONG = DWORDLONG 158 159foreign import capi unsafe "windows.h VER_SET_CONDITION" 160 vER_SET_CONDITION :: ULONGLONG -> DWORD -> BYTE -> IO ULONGLONG 161 162foreign import WINDOWS_CCONV unsafe "windows.h VerifyVersionInfoW" 163 verifyVersionInfo :: LPOSVERSIONINFOEX -> DWORD -> DWORDLONG -> IO BOOL 164-} 165