Чтение данных с весов Mettler Toledo PS60

Public Class NativeMethods
    Public Const DIGCF_PRESENT = &H2
    Public Const DIGCF_DEVICEINTERFACE = &H10

    Public Const FILE_FLAG_OVERLAPPED = &H40000000
    Public Const FILE_SHARE_READ = 1
    Public Const FILE_SHARE_WRITE = 2
    Public Const GENERIC_READ = &H80000000
    Public Const GENERIC_WRITE = &H40000000
    Public Const ACCESS_NONE = 0
    Public Const INVALID_HANDLE_VALUE = -1
	Public Const OPEN_EXISTING = 3

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Public Structure SP_DEVICE_INTERFACE_DETAIL_DATA
        Public cbSize As UInt32
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=256)> _
        Public DevicePath As String
    End Structure

    Public Structure SP_DEVICE_INTERFACE_DATA
        Public cbSize As Integer
        Public InterfaceClassGuid As System.Guid
        Public Flags As Integer
        Public Reserved As UIntPtr
    End Structure

    Public Structure SP_DEVINFO_DATA
        Public cbSize As Integer
        Public ClassGuid As System.Guid
        Public DevInst As Integer
        Public Reserved As UIntPtr
    End Structure

    Public Const HIDP_INPUT = 0
    Public Const HIDP_OUTPUT = 1
    Public Const HIDP_FEATURE = 2

    Public Structure HIDD_ATTRIBUTES
        Public cbSize As Integer
        Public VendorID As UShort
        Public ProductID As UShort
        Public VersionNumber As Short
    End Structure

    Public Structure SECURITY_ATTRIBUTES
        Public nLength As Integer
        Public lpSecurityDescriptor As IntPtr
        Public bInheritHandle As Boolean
    End Structure

    Public Declare Auto Function CreateFile Lib "kernel32.dll" (lpFileName As String, dwDesiredAccess As Integer, dwShareMode As Integer, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, dwCreationDisposition As Integer, dwFlagsAndAttributes As Integer, hTemplateFile As Integer) As IntPtr
    Public Declare Auto Function ReadFile Lib "kernel32.dll" (ByVal hFile As IntPtr, ByVal Buffer As IntPtr, ByVal nNumberOfBytesToRead As Integer, ByRef lpNumberOfBytesRead As Integer, ByVal Overlapped As IntPtr) As Integer
    Public Declare Auto Function CloseHandle Lib "kernel32.dll" (hObject As IntPtr) As Boolean

    Public Declare Auto Function SetupDiGetClassDevs Lib "setupapi.dll" (ByRef ClassGuid As System.Guid, ByVal Enumerator As Integer, ByVal hwndParent As IntPtr, ByVal Flags As Integer) As IntPtr
    Public Declare Auto Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (deviceInfoSet As IntPtr) As Boolean

    Public Declare Auto Function SetupDiEnumDeviceInfo Lib "setupapi.dll" (ByVal DeviceInfoSet As Integer, ByVal MemberIndex As Integer, ByRef DeviceInfoData As SP_DEVINFO_DATA) As Boolean
    Public Declare Auto Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByRef DeviceInfoData As SP_DEVINFO_DATA, ByRef InterfaceClassGuid As System.Guid, ByVal MemberIndex As UInteger, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Boolean

    Public Declare Auto Function SetupDiGetDeviceInterfaceDetailBuffer Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetail" (ByVal DeviceInfoSet As IntPtr, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, ByVal DeviceInterfaceDetailData As IntPtr, ByVal DeviceInterfaceDetailDataSize As Integer, ByRef RequiredSize As Integer, ByRef DeviceInfoData As IntPtr) As Boolean
    Public Declare Auto Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" (ByVal DeviceInfoSet As IntPtr, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, ByRef DeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA, ByVal DeviceInterfaceDetailDataSize As Integer, ByRef RequiredSize As Integer, ByRef DeviceInfoData As SP_DEVINFO_DATA) As Boolean


    Public Declare Auto Sub HidD_GetHidGuid Lib "hid.dll" Alias "HidD_GetHidGuid" (ByRef hidGuid As Guid)
    Public Declare Auto Function HidD_GetAttributes Lib "hid.dll" (hidDeviceObject As IntPtr, ByRef attributes As HIDD_ATTRIBUTES) As Boolean

End Class

Public Class ScaleReader
    Private Const VendorId = &HEB8      ' 0EB8 = Toledo, see http://usb-ids.gowdy.us/read/UD/
    Private Const ProductId = &HF000    ' F000 = PS60

    ' Scale status enumeration
    Public Enum ScaleStatus
        Fault
        StableAtZero
        InMotion
        WeightStable
        UnderZero
        OverWeight
        RequiresCalibration
        RequiresRezeroing
        RequiresGEO
        Unknown
    End Enum

    ' Scale weighing unit
    Public Enum WeightUnit
        UnitMilligram
        UnitGram
        UnitKilogram
        UnitCarats
        UnitTaels
        UnitGrains
        UnitPennyweights
        UnitMetricTon
        UnitAvoirTon
        UnitTroyOunce
        UnitOunce
        UnitPound
        UnitUnknown
    End Enum

    ' Scale measure report
    Public Structure ScaleReport
        Public ReportId As UShort       ' Scale report id
        Public Status As ScaleStatus    ' Scale status
        Public Unit As WeightUnit       ' Weighing unit
        Public Scaling As SByte          ' Scaling, power of 10
        Public WeightLsb As UShort      ' Least-significant byte of weight value
        Public WeightMsb As UShort      ' Most-significant byte of weight value
        Public ErrorCode As Integer     ' Error code

        ' Calculates weight from LSB, MSB and scaling
        Public Function GetWeight() As Double
            GetWeight = (WeightMsb * 256 + WeightLsb) * (10 ^ Scaling)
        End Function

    End Structure

    Private ioHandle As IntPtr  ' handle to read from device

    ' Opens device with desired access rights
    Private Function OpenDeviceIO(devicePath As String, deviceAccess As Integer) As IntPtr
        Dim security As NativeMethods.SECURITY_ATTRIBUTES

        security.lpSecurityDescriptor = IntPtr.Zero
        security.bInheritHandle = True
        security.nLength = Marshal.SizeOf(security)

        OpenDeviceIO = NativeMethods.CreateFile(devicePath, deviceAccess, NativeMethods.FILE_SHARE_READ + NativeMethods.FILE_SHARE_WRITE, security, NativeMethods.OPEN_EXISTING, 0, 0)
    End Function

    ' Close previously opened device
    Private Sub CloseDeviceIO(handle As IntPtr)
        NativeMethods.CloseHandle(handle)
    End Sub

    ' Disconnect from scale
    Public Sub Disconnect()
        CloseDeviceIO(ioHandle)
    End Sub

    ' Find Toledo PS60 scale and open to read weight values
    Public Function Connect() As Boolean
        Dim hidClass As Guid
        NativeMethods.HidD_GetHidGuid(hidClass) ' Obtain hid device class Guid to enumerate all hid devices

        Dim DeviceInfoSet As IntPtr
        Dim DeviceInfoData As NativeMethods.SP_DEVINFO_DATA
        Dim DeviceInterfaceData As NativeMethods.SP_DEVICE_INTERFACE_DATA
        Dim DeviceInterfaceDetailData As NativeMethods.SP_DEVICE_INTERFACE_DETAIL_DATA = Nothing
        Dim RequiredSize As Integer
        Dim success As Boolean

        DeviceInfoSet = NativeMethods.SetupDiGetClassDevs(hidClass, IntPtr.Zero, 0, NativeMethods.DIGCF_PRESENT + NativeMethods.DIGCF_DEVICEINTERFACE) ' Open hid device enumeration

        DeviceInterfaceData.cbSize = Marshal.SizeOf(DeviceInterfaceData)
        DeviceInterfaceDetailData.cbSize = 6
        DeviceInfoData.cbSize = Marshal.SizeOf(DeviceInfoData)

        Dim deviceIndex As Integer ' Current deviec index
        deviceIndex = 0

        Do While NativeMethods.SetupDiEnumDeviceInfo(DeviceInfoSet, deviceIndex, DeviceInfoData) ' Loop through all hid devices
            Dim deviceIfaceIndex As Integer ' Device interface index
            deviceIfaceIndex = 0
            Do While NativeMethods.SetupDiEnumDeviceInterfaces(DeviceInfoSet, DeviceInfoData, hidClass, deviceIfaceIndex, DeviceInterfaceData) ' Loop through all interfaces of current device
                success = NativeMethods.SetupDiGetDeviceInterfaceDetailBuffer(DeviceInfoSet, DeviceInterfaceData, IntPtr.Zero, 0, RequiredSize, IntPtr.Zero) ' Obtain buffer size
                success = NativeMethods.SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, DeviceInterfaceData, DeviceInterfaceDetailData, RequiredSize, RequiredSize, DeviceInfoData) ' Get device information using previously recieved buffer size

                Dim hidHandle As IntPtr
                hidHandle = OpenDeviceIO(DeviceInterfaceDetailData.DevicePath, NativeMethods.ACCESS_NONE) ' Open device with no access rights to get pid&vid

                If hidHandle <> NativeMethods.INVALID_HANDLE_VALUE Then

                    Dim deviceAttributes As NativeMethods.HIDD_ATTRIBUTES
                    deviceAttributes.cbSize = Marshal.SizeOf(deviceAttributes)

                    success = NativeMethods.HidD_GetAttributes(hidHandle, deviceAttributes) ' Read device attributes, including PID, VID and Version

                    If success And deviceAttributes.VendorID = VendorId And deviceAttributes.ProductID = ProductId Then ' If it matches Toledo PS60
                        CloseDeviceIO(hidHandle)    ' Close device
                        ioHandle = OpenDeviceIO(DeviceInterfaceDetailData.DevicePath, NativeMethods.GENERIC_READ) ' And reopen with access rights to read reports
                        NativeMethods.SetupDiDestroyDeviceInfoList(DeviceInfoSet) ' Close enumeration
                        Connect = True
                        Exit Function
                    End If

                    CloseDeviceIO(hidHandle)
                End If
                deviceIfaceIndex = deviceIfaceIndex + 1
            Loop

            deviceIndex = deviceIndex + 1
        Loop
        NativeMethods.SetupDiDestroyDeviceInfoList(DeviceInfoSet) ' Close enumeration

        Connect = False
    End Function

    ' Reads current weight from scale
    Public Function ReadValue() As ScaleReport
        Dim bytesRead As Integer
        Dim buffer(10) As Byte
        Dim bufPtr As IntPtr

        bufPtr = Marshal.AllocHGlobal(10) ' Allocate 10 bytes for report

        ReadValue = Nothing

        Dim res As Integer
        res = NativeMethods.ReadFile(ioHandle, bufPtr, 10, bytesRead, IntPtr.Zero) ' Read 10 bytes from scale

        If res > 0 Then ' 0=Failure, any positive is success
            Marshal.Copy(bufPtr, buffer, 0, 10) ' Copy unmamanged buffer to managed byte array
            If bytesRead < 6 Then ' Report must be 6 bytes or greater (for compatibility)
                ReadValue.Status = ScaleStatus.Fault
                Marshal.FreeHGlobal(bufPtr)
                Exit Function
            End If

            Dim rep As ScaleReport

            rep.ReportId = buffer(0) ' byte #0 is report id
            Select Case buffer(1)    ' byte #1 is scale status
                Case &H1
                    rep.Status = ScaleStatus.Fault
                Case &H2
                    rep.Status = ScaleStatus.StableAtZero
                Case &H3
                    rep.Status = ScaleStatus.InMotion
                Case &H4
                    rep.Status = ScaleStatus.WeightStable
                Case &H5
                    rep.Status = ScaleStatus.UnderZero
                Case &H6
                    rep.Status = ScaleStatus.OverWeight
                Case &H7
                    rep.Status = ScaleStatus.RequiresCalibration
                Case &H8
                    rep.Status = ScaleStatus.RequiresRezeroing
                Case &H9
                    rep.Status = ScaleStatus.RequiresGEO
                Case Else
                    rep.Status = ScaleStatus.Unknown
            End Select

            Select Case buffer(2)       ' byte #2 is scale unit
                Case &H1
                    rep.Unit = WeightUnit.UnitMilligram
                Case &H2
                    rep.Unit = WeightUnit.UnitGram
                Case &H3
                    rep.Unit = WeightUnit.UnitKilogram
                Case &H4
                    rep.Unit = WeightUnit.UnitCarats
                Case &H5
                    rep.Unit = WeightUnit.UnitTaels
                Case &H6
                    rep.Unit = WeightUnit.UnitGrains
                Case &H7
                    rep.Unit = WeightUnit.UnitPennyweights
                Case &H8
                    rep.Unit = WeightUnit.UnitMetricTon
                Case &H9
                    rep.Unit = WeightUnit.UnitAvoirTon
                Case &HA
                    rep.Unit = WeightUnit.UnitTroyOunce
                Case &HB
                    rep.Unit = WeightUnit.UnitOunce
                Case &HC
                    rep.Unit = WeightUnit.UnitPound
                Case Else
                    rep.Unit = WeightUnit.UnitUnknown
            End Select

            rep.Scaling = IIf(buffer(3) < 128, buffer(3), buffer(3) - 256)     ' byte #3 is scaling
            rep.WeightLsb = buffer(4)   ' byte #4 is LSB
            rep.WeightMsb = buffer(5)   ' byte #5 is MSB

            ReadValue = rep
        Else
            Dim err = Marshal.GetLastWin32Error
            ReadValue.Status = ScaleStatus.Fault
            ReadValue.ErrorCode = err
        End If
        Marshal.FreeHGlobal(bufPtr)
    End Function


End Class