The front matter:
{-# LANGUAGE ForeignFunctionInterface #-} module Win32.Kernel32 (getComputerName) where import Control.Monad (when, unless) import Data.Bits ((.|.)) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (nullPtr) import Foreign.Storable (peek, poke) import System.Win32.Types (DWORD, LPDWORD, LPTSTR, LPVOID, peekTStringLen, peekTString, withTString) #include <windows.h>With hsc2hs, it's possible to #include C headers and use constants in Haskell programs, as we'll see below.
Now to get hold of a few entry points in kernel32.dll. The types defined in System.Win32.Types are handy:
foreign import stdcall unsafe "GetComputerNameW" win32_getComputerName :: LPTSTR -> LPDWORD -> IO Bool foreign import stdcall unsafe "GetLastError" win32_getLastError :: IO DWORD foreign import stdcall unsafe "FormatMessageW" win32_formatMessage :: DWORD -> LPVOID -> DWORD -> DWORD -> LPTSTR -> DWORD -> LPVOID -> IO DWORDNote the use of the stdcall calling convention and that we're calling the wide-character versions.
GetComputerName takes two parameters, a pointer to a character-buffer and a pointer to an in-out DWORD (in: capacity; out: used). On the Haskell side, this means a couple of allocations, initialize the length parameter, call GetComputerName, and read the result:
getComputerName :: IO String getComputerName = withTString maxBuf $ \buf -> alloca $ \len -> do poke len (fromIntegral maxLength) success <- win32_getComputerName buf len unless success $ failWithLastError "GetComputerName" len' <- peek len peekTStringLen (buf, (fromIntegral len')) where maxBuf = replicate maxLength '\0' maxLength = #const MAX_COMPUTERNAME_LENGTHThe #const bit at the end tells hsc2hs to substitute the value of the C preprocessor symbol MAX_COMPUTERNAME_LENGTH.
If all goes well, GetComputerName returns non-zero, but we'd like to handle cases when things go wrong. In the Win32 API, we'd call GetLastError and convert the error code to a human-readable diagnostic with FormatMessage:
failWithLastError :: String -> IO a failWithLastError name = do code <- win32_getLastError withTString errbuf $ \buf -> do gotmsg <- win32_formatMessage flags nullPtr code lang buf (fromIntegral errlen) nullPtr fmtcode <- win32_getLastError when (gotmsg == 0) $ fail $ name ++ " failed: " ++ show (code, fmtcode) msg <- peekTString buf fail $ name ++ ": " ++ filter notEOL msg where errbuf = replicate errlen '\0' errlen = 300 flags = #const FORMAT_MESSAGE_FROM_SYSTEM .|. #const FORMAT_MESSAGE_IGNORE_INSERTS lang = 0 notEOL c = c /= '\n' && c /= '\r'FormatMessage can fail too, so in that case, the poor user is stuck with a couple of opaque error codes. Otherwise, peekTString copies the formatted error message for use with fail. Note also that Win32's FormatMessage is variadic, but this wrapper does not take advantage, instead passing a canned null pointer.
Having nice error messages can be sort of helpful with programming errors such as forgetting to initialize the length parameter in a call to GetComputerName:
$ cabal test test: user error (GetComputerName: The file name is too long.)The code above lives in a file named Kernel32.hsc. The package definition (.cabal file) points to the module name, and when Cabal finds the .hsc extension, it transparently runs the code through hsc2hs:
Library hs-source-dirs: src exposed-modules: Win32.Kernel32 build-depends: base, Win32 extensions: ForeignFunctionInterface ghc-options: -WallThe package includes a simple test that calls getComputerName and prints the result to the standard output, so the following sequence of commands should remind you of your machine's name:
cabal configure -ftest cabal build cabal testThe code is also available on GitHub.
Posts
