System.USB:来自Device的串口

时间:2016-07-23 21:20:59

标签: haskell libusb

我使用usb-1.3.0.4 / System.USB。扫描并选择了相关的串行USB设备后,如何找到相应的串口(例如Windows上的COM3)?

以下是我之后的例子:

module Main (main) where

import System.USB
import System.Hardware.Serialport
import qualified Data.Vector as V
import Data.Maybe

main :: IO ()
main = do
    devicePort 0x2341 0x0043 >>= either putStrLn usePort
    where usePort p = do
              s <- openSerial p defaultSerialSettings
              putStrLn $ "opened serial port " ++ p
              closeSerial s

-- | Find port for attached USB serial device
devicePort :: VendorId -> ProductId -> IO (Either String FilePath)
devicePort vid pid = do
    ctx <- newCtx
    findDevice ctx vid pid >>= \md -> case md of
        Just dev -> fmap (maybe (Left "not a serial device") Right) $ serialPort dev
        Nothing -> return $ Left "device not found"

-- | Scan for first device with given vendor and product identifiers
findDevice :: Ctx -> VendorId -> ProductId -> IO (Maybe Device)
findDevice ctx vid pid = fmap (listToMaybe . V.toList) $ V.filterM p =<< getDevices ctx
    where p x = do
              d <- getDeviceDesc x
              return $ deviceVendorId d == vid && deviceProductId d == pid

serialPort :: Device -> IO (Maybe FilePath)
serialPort dev = undefined

最后一个函数的可能实现是什么?

3 个答案:

答案 0 :(得分:2)

您需要在注册表中搜索您的设备。在密钥HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum下有多个密钥(在大多数情况下是USB,但有时驱动程序将其安装在不同的子密钥中),它们本身包含格式为VID_xxxx&PID_xxxx的密钥。你必须先找到这个密钥。它很可能类似于HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USB\VID_xxxx&PID_xxxx

此键包含自己的新子键。这些子键包含一个名为Device Parameters的键,其中包含所需的键值对PortName,其端口类似于COM3。

可悲的是,我不知道Haskell是如何做到的。

答案 1 :(得分:1)

根据干预者的建议和一些挖掘我完全放弃了usblib并直接通过Windows上的注册表实现(我将离开Linux一天):

{-# LANGUAGE RecordWildCards #-}
module USBSerial (USBSerial(..), usbSerials) where

import System.Win32.Registry (hKEY_LOCAL_MACHINE, regOpenKey, regCloseKey, regQueryValue, regQueryValueEx)
import System.Win32.Types (DWORD, HKEY)
import Control.Exception (handle, bracket, SomeException(..))
import Foreign (toBool, Storable(peek, sizeOf), castPtr, alloca)
import Data.List.Split (splitOn)
import Data.List (stripPrefix)
import Numeric (readHex, showHex)
import Data.Maybe (catMaybes)
import Control.Monad (forM)

data USBSerial = USBSerial
    { key           :: String
    , vendorId      :: Int
    , productId     :: Int
    , portName      :: String
    , friendlyName  :: String
    }

instance Show USBSerial where
    show USBSerial{..} = unwords [ portName, toHex vendorId, toHex productId, friendlyName ]
        where toHex x = let s = showHex x "" in replicate (4 - length s) '0' ++ s

usbSerials :: Maybe Int -> Maybe Int -> IO [USBSerial]
usbSerials mVendorId mProductId = withHKey hKEY_LOCAL_MACHINE path $ \hkey -> do
    n <- regQueryValueDWORD hkey "Count"
    fmap catMaybes $ forM [0..n-1] $ \i -> do
        key <- regQueryValue hkey . Just . show $ i
        case keyToVidPid key of
            Just (vendorId, productId)
                | maybe True (==vendorId) mVendorId && maybe True (==productId) mProductId -> do
                    portName <- getPortName key
                    friendlyName <- getFriendlyName key
                    return $ Just USBSerial{..}
            _ -> return Nothing
    where path = "SYSTEM\\CurrentControlSet\\Services\\usbser\\Enum"

getPortName :: String -> IO String
getPortName serial = withHKey hKEY_LOCAL_MACHINE path $ flip regQueryValue (Just "PortName")
    where path = "SYSTEM\\CurrentControlSet\\Enum\\" ++ serial ++ "\\Device Parameters"

getFriendlyName :: String -> IO String
getFriendlyName serial = withHKey hKEY_LOCAL_MACHINE path $ flip regQueryValue (Just "FriendlyName")
    where path = "SYSTEM\\CurrentControlSet\\Enum\\" ++ serial

keyToVidPid :: String -> Maybe (Int, Int)
keyToVidPid name
    | (_:s:_) <- splitOn "\\" name
    , (v:p:_) <- splitOn "&" s
    , Just v <- fromHex =<< stripPrefix "VID_" v
    , Just p <- fromHex =<< stripPrefix "PID_" p = Just (v, p)
    | otherwise = Nothing
    where fromHex s = case readHex s of
            [(x, "")] -> Just x
            _         -> Nothing

withHKey :: HKEY -> String -> (HKEY -> IO a) -> IO a
withHKey hive path = handle (\(SomeException e) -> error $ show e) . bracket (regOpenKey hive path) regCloseKey

-- | Read DWORD value from registry.
-- From http://compgroups.net/comp.lang.haskell/working-with-the-registry-windows-xp/2579164
regQueryValueDWORD :: HKEY -> String -> IO DWORD
regQueryValueDWORD hkey name = alloca $ \ptr -> do
    regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
    peek ptr

例如:

main :: IO ()
main = usbSerials (Just 0x2341) Nothing >>= mapM_ print

产生如下输出:

COM7 2341 8036 Arduino Leonardo (COM7)
COM3 2341 0043 Arduino Uno (COM3)

答案 2 :(得分:0)

如果你真的无法以其他方式解决它,请忽略这个答案。

你应该考虑其他选择。您可以简单地接受串行接口的名称作为程序的参数或作为可配置选项,而不是扫描与特定供应商或产品ID匹配的设备。在Windows上,这将是“COMx”形式,而在Unix上它只是一个路径。

此外,串行接口可能并不总是USB设备,因此无法通过扫描USB设备来枚举PCI或集成串行端口。此外,将代码硬编码到源代码中会在设备稍后被其他内容替换时进行痛苦的更新。

静态端口命名

如果您使用的是Windows,则分配自定义接口编号(例如COM7)时,如果拔下接口或重新启动计算机,则应使其保持稳定。在Linux上,它有点做作:您可以添加与产品和供应商ID匹配的Udev规则,以便它创建具有自定义名称的节点,例如/dev/arduinoN。我强烈建议您遵循这种方法,因为提供手动路径或修改Udev文件(可以说)比重新编译应用程序更容易。我知道这样做的DMX产品:由于它使用现成的FTDI接口,因此它附带了一个与该供应商和产品ID匹配的规则,并重命名节点/dev/dmxN。虽然规则与其他FTDI接口发生冲突,但在您的情况下,由于Arduino有自己的产品和供应商ID分配,因此不会这样做。