PhysTech.vb - master - Radiator/VesDriverRadiatorTagn

PhysTech.vb
134 строки5 KB
Radiator
create: kernel_dec.vb, metrabus.vb, Modbus_proc.vb, nais_proc.vb, PhysTech.vb, Program.vb, ReadCFG.vb, Tenso_proc.vb, Tenso643_proc.vb, Cas_proc.vb, comport_api.vb, Error_Proc.vb
18 май 2026, 15:04
Верифицирован
18 май 2026, 15:043aaccb8
Module PhysTech

    Private ReadOnly ETX() As Byte = {&HD, &HA}   ' Конец пакета

    Private Function IsWeightStable(statusByte As Byte) As Boolean
        ' Бит D5: Весы успокоены (0x20 = 00100000 в двоичной системе)
        Return (statusByte And &H20) <> 0
    End Function

    Private Function IsWeightOverflow(statusByte As Byte) As Boolean
        ' Бит D4: Флаг переполнения (0x10 = 00010000 в двоичной системе)
        Return (statusByte And &H10) <> 0
    End Function
    Private Function PT_ConvertBCDToFloat(packet As Byte()) As Single

        ' 1. Декодирование BCD (первые 3 байта) в строку цифр
        Dim digits As String = ""
        For i As Integer = 2 To 0 Step -1
            Dim highNibble As Integer = (packet(i) >> 4) And &HF
            Dim lowNibble As Integer = packet(i) And &HF
            digits &= highNibble.ToString() & lowNibble.ToString()
        Next

        ' 2. Определение положения точки из 4-го байта (Биты D0, D1, D2)
        Dim statusByte As Byte = packet(3)
        Dim pointPos As Integer = statusByte And &H7

        If pointPos > 0 AndAlso pointPos <= 5 Then
            Dim splitIdx As Integer = 6 - pointPos
            digits = digits.Substring(0, splitIdx) & "." & digits.Substring(splitIdx)
        End If

        ' 3. Преобразование строки в число с плавающей точкой
        Dim value As Single = Single.Parse(digits, System.Globalization.CultureInfo.InvariantCulture)

        ' 4. Учет знака числа (Бит D7)
        Dim isNegative As Boolean = (statusByte And &H80) <> 0
        If isNegative Then
            value = -value
        End If

        Return value
    End Function

    Public Sub PhysTechRead(ByRef MyCfg As myCFG)

        Dim My_Com As IntPtr
        Dim MyNewLine As String = vbCrLf
        Dim errcount As Int16 = 0
        Dim isStable As Boolean = False
        Dim isNotOverflow As Boolean = True
        Dim hasUnstable As Boolean = False
        Dim hasOverflow As Boolean = False
        Dim MyWeight As Single

        Try
            My_Com = My_Com_Open_API(MyCfg)

            If Not CheckPortHandleAndLog(My_Com, MyCfg.nCom, Sw) Then
                Exit Sub ' Выходим из процедуры, если порт не открылся
            End If

            Do
                Try

                    If errcount > 100 Then
                        Dim ex As New InvalidOperationException("Превышено количество ошибок чтения веса")
                        Throw ex
                    End If

                    Dim readBuffer() As Byte = MyCom_ReadBytesByDiv(My_Com, ETX)

                    If readBuffer.Length <= 0 Then
                        Log("Нет ответа от прибора.")
                        errcount += 20 'попытаемся 5 раз
                        Continue Do
                    End If

                    If readBuffer.Length <> 6 Then
                        Log("Неверный кадр от прибора.")
                        errcount += 1 'попытаемся 100 раз
                        Continue Do
                    End If

                    isStable = IsWeightStable(readBuffer(3))
                    'isNotOverflow = IsWeightOverflow(readBuffer(3))


                    If isStable And isNotOverflow Then

                        errcount = 0
                        hasUnstable = False
                        hasOverflow = False

                        MyWeight = PT_ConvertBCDToFloat(readBuffer)
                        MyWeight = MyWeight / MyCfg.Div
                        ' --- ЗАПИСЬ ВЕСА ---
                        My_Ves_Fix(MyCfg, MyWeight)
                        ' Пауза перед следующим опросом (5 секунд)
                        My_Pause_Mil_Sec(5, 0)

                        Continue Do
                    End If

                    If Not isStable Then
                        hasUnstable = True
                    End If

                    If Not isNotOverflow Then
                        hasOverflow = True
                    End If

                Catch ex As Exception

                    DataReadError(MyCfg, ex)

                    Sw.Close()
                    If My_Com <> INVALID_HANDLE_VALUE Then CloseHandle(My_Com)
                    Return

                End Try
            Loop

        Catch ex As Exception
            Log("Ошибка инициализации ком порта " & MyCfg.nCom)
            Log(ex.Message)
            Sw.Close()
        Finally
            If My_Com <> INVALID_HANDLE_VALUE Then CloseHandle(My_Com)
        End Try

    End Sub

End Module