Win32-extras-0.1.0.0: System/Win32/Info/Computer.hsc
{-# LANGUAGE CPP #-}
{- |
Module : System.Win32.Info.Computer
Copyright : 2012 shelarcy
License : BSD-style
Maintainer : shelarcy@gmail.com
Stability : Provisional
Portability : Non-portable (Win32 API)
Information about your computer.
-}
module System.Win32.Info.Computer where
import Data.Word ( Word64 )
import Foreign.Ptr ( Ptr )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( Storable(..) )
import System.Win32.Error ( failIfFalse_ )
import System.Win32.Info ( SMSetting )
import System.Win32.String ( LPTSTR, withTString, withTStringBuffer
, peekTString, peekTStringLen )
import System.Win32.Types ( BOOL, WORD, DWORD, LPDWORD, BYTE )
#define _WIN32_WINNT 0x0500
#include <windows.h>
#include <Lmcons.h>
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_COMPUTERNAME_LENGTH
foreign import WINDOWS_CCONV unsafe "GetComputerNameW"
c_GetComputerName :: LPTSTR -> LPDWORD -> IO Bool
setComputerName :: String -> IO ()
setComputerName name =
withTString name $ \buf ->
failIfFalse_ "SetComputerName"
$ 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
}
-}
foreign import WINDOWS_CCONV unsafe "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 charactor.
peekTString buf
where
-- This requires Lmcons.h
maxLength = #const UNLEN
foreign import WINDOWS_CCONV unsafe "GetUserNameW"
c_GetUserName :: LPTSTR -> LPDWORD -> IO Bool
----------------------------------------------------------------
-- Version Info
----------------------------------------------------------------
getVersionEx :: IO OSVERSIONINFOEX
getVersionEx =
alloca $ \buf -> do
(#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf
(#{size OSVERSIONINFOEXW}::DWORD)
failIfFalse_ "GetVersionEx"
$ c_GetVersionEx buf
peek buf
foreign import WINDOWS_CCONV unsafe "GetVersionExW"
c_GetVersionEx :: LPOSVERSIONINFOEX -> IO BOOL
{-
foreign import WINDOWS_CCONV unsafe "VerifyVersionInfoW"
verifyVersionInfo :: LPOSVERSIONINFOEX -> DWORD -> DWORDLONG -> IO BOOL
-}
type DWORDLONG = Word64
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
, wReserved :: BYTE
} deriving Show
instance Storable OSVERSIONINFOEX where
sizeOf = const #{size struct _OSVERSIONINFOEXW}
alignment = sizeOf
poke buf info = do
(#poke OSVERSIONINFOEXW, dwOSVersionInfoSize) buf
$ sizeOf (undefined::OSVERSIONINFOEX)
(#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 (wReserved info)
peek buf = do
dwMajorVersion <- (#peek OSVERSIONINFOEXW, dwMajorVersion) buf
dwMinorVersion <- (#peek OSVERSIONINFOEXW, dwMinorVersion) buf
dwBuildNumber <- (#peek OSVERSIONINFOEXW, dwBuildNumber) buf
dwPlatformId <- (#peek OSVERSIONINFOEXW, dwPlatformId) buf
szCSDVersion' <- (#peek OSVERSIONINFOEXW, szCSDVersion) buf
szCSDVersion <- peekTString szCSDVersion'
wServicePackMajor <- (#peek OSVERSIONINFOEXW, wServicePackMajor) buf
wServicePackMinor <- (#peek OSVERSIONINFOEXW, wServicePackMinor) buf
wSuiteMask <- (#peek OSVERSIONINFOEXW, wSuiteMask) buf
wProductType <- (#peek OSVERSIONINFOEXW, wProductType) buf
wReserved <- (#peek OSVERSIONINFOEXW, wReserved) buf
return $ OSVERSIONINFOEX dwMajorVersion dwMinorVersion
dwBuildNumber dwPlatformId szCSDVersion
wServicePackMajor wServicePackMinor
wSuiteMask wProductType wReserved
----------------------------------------------------------------
-- Processor features
----------------------------------------------------------------
foreign import WINDOWS_CCONV unsafe "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
-}