System/Win32/Info/Computer.hsc
{-# LANGUAGE CPP #-}
{- |
Module : System.Win32.Info.Computer
Copyright : 2012-2013 shelarcy
License : BSD-style
Maintainer : shelarcy@gmail.com
Stability : Provisional
Portability : Non-portable (Win32 API)
Information about your computer.
-}
module System.Win32.Info.Computer
( -- * Environment Strings
expandEnvironmentStrings, c_ExpandEnvironmentStrings
-- * Computer Name
, getComputerName, setComputerName
, c_GetComputerName, c_SetComputerName
-- * System metrics
, getSystemMetrics
, sM_CMONITORS
, sM_IMMENABLED
, sM_MOUSEWHEELPRESENT
, sM_REMOTESESSION
, sM_SAMEDISPLAYFORMAT
, sM_XVIRTUALSCREEN
, sM_YVIRTUALSCREEN
, sM_SERVERR2
, sM_MEDIACENTER
, sM_STARTER
, sM_TABLETPC
-- * User name
, getUserName, c_GetUserName
-- * Version Info
, OSVERSIONINFOEX(..), POSVERSIONINFOEX, LPOSVERSIONINFOEX
, ProductType(..)
, getVersionEx, c_GetVersionEx
-- * Processor features
, ProcessorFeature
, isProcessorFeaturePresent
, pF_3DNOW_INSTRUCTIONS_AVAILABLE
, pF_COMPARE_EXCHANGE_DOUBLE
, pF_FLOATING_POINT_EMULATED
, pF_FLOATING_POINT_PRECISION_ERRATA
, pF_MMX_INSTRUCTIONS_AVAILABLE
, pF_PAE_ENABLED
, pF_RDTSC_INSTRUCTION_AVAILABLE
, pF_XMMI_INSTRUCTIONS_AVAILABLE
, pF_XMMI64_INSTRUCTIONS_AVAILABLE
) where
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( Storable(..) )
import System.Win32.Info ( SMSetting )
import System.Win32.Info.Version
import System.Win32.String ( LPCTSTR, LPTSTR, withTString, withTStringBuffer
, peekTString, peekTStringLen )
import System.Win32.Types ( BOOL, failIfFalse_ )
import System.Win32.Utils ( tryWithoutNull )
import System.Win32.Word ( DWORD, LPDWORD )
#include <windows.h>
#include <lmcons.h>
#include "alignment.h"
##include "windows_cconv.h"
----------------------------------------------------------------
-- Environment Strings
----------------------------------------------------------------
expandEnvironmentStrings :: String -> IO String
expandEnvironmentStrings name =
withTString name $ \ c_name ->
tryWithoutNull (unwords ["ExpandEnvironmentStrings", name])
(\buf len -> c_ExpandEnvironmentStrings c_name buf len) 512
foreign import WINDOWS_CCONV unsafe "windows.h ExpandEnvironmentStringsW"
c_ExpandEnvironmentStrings :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD
----------------------------------------------------------------
-- Computer Name
----------------------------------------------------------------
getComputerName :: IO String
getComputerName =
withTStringBuffer maxLength $ \buf ->
with (fromIntegral maxLength) $ \len -> do
failIfFalse_ "GetComputerName"
$ c_GetComputerName buf len
len' <- peek len
peekTStringLen (buf, (fromIntegral len'))
where
maxLength = #const MAX_PATH
foreign import WINDOWS_CCONV unsafe "GetComputerNameW"
c_GetComputerName :: LPTSTR -> LPDWORD -> IO Bool
setComputerName :: String -> IO ()
setComputerName name =
withTString name $ \buf ->
failIfFalse_ (unwords ["SetComputerName", name])
$ c_SetComputerName buf
foreign import WINDOWS_CCONV unsafe "SetComputerNameW"
c_SetComputerName :: LPTSTR -> IO Bool
{-
type COMPUTER_NAME_FORMAT = UINT
{enum COMPUTER_NAME_FORMAT,
, computerNameNetBIOS = ComputerNameNetBIOS
, computerNameDnsHostname = ComputerNameDnsHostname
, computerNameDnsDomain = ComputerNameDnsDomain
, computerNameDnsFullyQualified = ComputerNameDnsFullyQualified
, computerNamePhysicalNetBIOS = ComputerNamePhysicalNetBIOS
, computerNamePhysicalDnsHostname = ComputerNamePhysicalDnsHostname
, computerNamePhysicalDnsDomain = ComputerNamePhysicalDnsFullyQualified
, computerNamePhysicalDnsFullyQualified = ComputerNamePhysicalDnsFullyQualified
, computerNameMax = ComputerNameMax
}
-}
----------------------------------------------------------------
-- Hardware Profiles
----------------------------------------------------------------
{-
-- TODO: Decide HW_PROFILE_INFO type design
type LPHW_PROFILE_INFO = Ptr HW_PROFILE_INFO
data HW_PROFILE_INFO = HW_PROFILE_INFO
{ dwDockInfo :: DWORD
, szHwProfileGuid :: String -- Should we use GUID type instead of String?
, szHwProfileName :: String
} deriving Show
instance Storable HW_PROFILE_INFO where
sizeOf = const #{size HW_PROFILE_INFOW}
alignment _ = #alignment HW_PROFILE_INFOW
poke buf info = do
(#poke HW_PROFILE_INFOW, dwDockInfo) buf (dwDockInfo info)
withTString (szHwProfileGuid info) $ \szHwProfileGuid' ->
(#poke HW_PROFILE_INFOW, szHwProfileGuid) buf szHwProfileGuid'
withTString (szHwProfileName info) $ \szHwProfileName' ->
(#poke HW_PROFILE_INFOW, szHwProfileName) buf szHwProfileName'
peek buf = do
dockInfo <- (#peek HW_PROFILE_INFOW, dwDockInfo) buf
hwProfileGuid <- peekTString $ (#ptr HW_PROFILE_INFOW, szHwProfileGuid) buf
hwProfileName <- peekTString $ (#ptr HW_PROFILE_INFOW, szHwProfileName) buf
return $ HW_PROFILE_INFO dockInfo hwProfileGuid hwProfileName
getCurrentHwProfile :: IO HW_PROFILE_INFO
getCurrentHwProfile =
alloca $ \buf -> do
failIfFalse_ "GetCurrentHwProfile"
$ c_GetCurrentHwProfile buf
peek buf
foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentHwProfileW"
c_GetCurrentHwProfile :: LPHW_PROFILE_INFO -> IO Bool
-}
----------------------------------------------------------------
-- System metrics
----------------------------------------------------------------
foreign import WINDOWS_CCONV unsafe "windows.h GetSystemMetrics"
getSystemMetrics :: SMSetting -> IO Int
#{enum SMSetting,
, sM_CMONITORS = SM_CMONITORS
, sM_IMMENABLED = SM_IMMENABLED
, sM_MOUSEWHEELPRESENT = SM_MOUSEWHEELPRESENT
, sM_REMOTESESSION = SM_REMOTESESSION
, sM_SAMEDISPLAYFORMAT = SM_SAMEDISPLAYFORMAT
, sM_XVIRTUALSCREEN = SM_XVIRTUALSCREEN
, sM_YVIRTUALSCREEN = SM_YVIRTUALSCREEN
, sM_SERVERR2 = SM_SERVERR2
, sM_MEDIACENTER = SM_MEDIACENTER
, sM_STARTER = SM_STARTER
, sM_TABLETPC = SM_TABLETPC
}
----------------------------------------------------------------
-- User name
----------------------------------------------------------------
-- | Get user name. See: <https://github.com/haskell/win32/issues/8>, <http://lpaste.net/41521>
getUserName :: IO String
getUserName =
withTStringBuffer maxLength $ \buf ->
with (fromIntegral maxLength) $ \len -> do
failIfFalse_ "GetComputerName"
$ c_GetUserName buf len
-- GetUserNameW includes NUL character.
peekTString buf
where
-- This requires Lmcons.h
maxLength = #const UNLEN
foreign import WINDOWS_CCONV unsafe "windows.h GetUserNameW"
c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool
----------------------------------------------------------------
-- Processor features
----------------------------------------------------------------
foreign import WINDOWS_CCONV unsafe "windows.h IsProcessorFeaturePresent"
isProcessorFeaturePresent :: ProcessorFeature -> IO BOOL
type ProcessorFeature = DWORD
#{enum ProcessorFeature,
, pF_3DNOW_INSTRUCTIONS_AVAILABLE = PF_3DNOW_INSTRUCTIONS_AVAILABLE
, pF_COMPARE_EXCHANGE_DOUBLE = PF_COMPARE_EXCHANGE_DOUBLE
, pF_FLOATING_POINT_EMULATED = PF_FLOATING_POINT_EMULATED
, pF_FLOATING_POINT_PRECISION_ERRATA = PF_FLOATING_POINT_PRECISION_ERRATA
, pF_MMX_INSTRUCTIONS_AVAILABLE = PF_MMX_INSTRUCTIONS_AVAILABLE
, pF_PAE_ENABLED = PF_PAE_ENABLED
, pF_RDTSC_INSTRUCTION_AVAILABLE = PF_RDTSC_INSTRUCTION_AVAILABLE
, pF_XMMI_INSTRUCTIONS_AVAILABLE = PF_XMMI_INSTRUCTIONS_AVAILABLE
, pF_XMMI64_INSTRUCTIONS_AVAILABLE = PF_XMMI64_INSTRUCTIONS_AVAILABLE
}
{-
, pF_CHANNELS_ENABLED = PF_CHANNELS_ENABLED
, pF_NX_ENABLED = PF_NX_ENABLED
, pF_COMPARE_EXCHANGE128 = PF_COMPARE_EXCHANGE128
, pF_COMPARE64_EXCHANGE128 = PF_COMPARE64_EXCHANGE128
, pF_SECOND_LEVEL_ADDRESS_TRANSLATION = PF_SECOND_LEVEL_ADDRESS_TRANSLATION
, pF_SSE3_INSTRUCTIONS_AVAILABLE = PF_SSE3_INSTRUCTIONS_AVAILABLE
, pF_VIRT_FIRMWARE_ENABLED = PF_VIRT_FIRMWARE_ENABLED
, pF_XSAVE_ENABLED = PF_XSAVE_ENABLED
-}