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