{-# LINE 1 "libraries\\Win32\\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 ) {-# LINE 69 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} {-# LINE 70 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} #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 = 15 {-# LINE 98 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} 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: Deside 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 sM_CMONITORS :: SMSetting sM_CMONITORS = 80 sM_IMMENABLED :: SMSetting sM_IMMENABLED = 82 sM_MOUSEWHEELPRESENT :: SMSetting sM_MOUSEWHEELPRESENT = 75 sM_REMOTESESSION :: SMSetting sM_REMOTESESSION = 4096 sM_SAMEDISPLAYFORMAT :: SMSetting sM_SAMEDISPLAYFORMAT = 81 sM_XVIRTUALSCREEN :: SMSetting sM_XVIRTUALSCREEN = 76 sM_YVIRTUALSCREEN :: SMSetting sM_YVIRTUALSCREEN = 77 sM_SERVERR2 :: SMSetting sM_SERVERR2 = 89 sM_MEDIACENTER :: SMSetting sM_MEDIACENTER = 87 sM_STARTER :: SMSetting sM_STARTER = 88 sM_TABLETPC :: SMSetting sM_TABLETPC = 86 {-# LINE 186 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} ---------------------------------------------------------------- -- 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 charactor. peekTString buf where -- This requires Lmcons.h maxLength = 256 {-# LINE 203 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} 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 pF_3DNOW_INSTRUCTIONS_AVAILABLE :: ProcessorFeature pF_3DNOW_INSTRUCTIONS_AVAILABLE = 7 pF_COMPARE_EXCHANGE_DOUBLE :: ProcessorFeature pF_COMPARE_EXCHANGE_DOUBLE = 2 pF_FLOATING_POINT_EMULATED :: ProcessorFeature pF_FLOATING_POINT_EMULATED = 1 pF_FLOATING_POINT_PRECISION_ERRATA :: ProcessorFeature pF_FLOATING_POINT_PRECISION_ERRATA = 0 pF_MMX_INSTRUCTIONS_AVAILABLE :: ProcessorFeature pF_MMX_INSTRUCTIONS_AVAILABLE = 3 pF_PAE_ENABLED :: ProcessorFeature pF_PAE_ENABLED = 9 pF_RDTSC_INSTRUCTION_AVAILABLE :: ProcessorFeature pF_RDTSC_INSTRUCTION_AVAILABLE = 8 pF_XMMI_INSTRUCTIONS_AVAILABLE :: ProcessorFeature pF_XMMI_INSTRUCTIONS_AVAILABLE = 6 pF_XMMI64_INSTRUCTIONS_AVAILABLE :: ProcessorFeature pF_XMMI64_INSTRUCTIONS_AVAILABLE = 10 {-# LINE 227 "libraries\\Win32\\System\\Win32\\Info\\Computer.hsc" #-} {- , 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 -}