Module scaleMoudule Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Integer Public rxMessage As String Public pasingdata As String Public Const RetryCnt As Integer = 3 Dim WaitGo As String Public Function MeasureScale(timeout As Long) As String Dim StartTick, CurrTick As Long Dim tmpVal As String Dim tmpRxMessage As String = "" Dim CmdRet As String = "" Dim MeasureVal As Double For cnt = 1 To RetryCnt weightForm.cmdSerialPort.DiscardInBuffer() weightForm.cmdSerialPort.DiscardOutBuffer() rxMessage = "" StartTick = GetTickCount weightForm.cmdSerialPort.Write(Chr(&H5)) While (CurrTick - StartTick <= timeout) CurrTick = GetTickCount CmdRet = ReceiveByteSerial() Select Case CmdRet Case "START" StartTick = GetTickCount rxMessage = "" weightForm.cmdSerialPort.Write(Chr(&H11)) Case "COMPLETE" CmdRet = "FAIL" If Len(rxMessage) = 15 Then WaitGo = Mid(rxMessage, 3, 1) tmpVal = Mid(rxMessage, 5, 6) For i = 1 To Len(tmpVal) If Mid(tmpVal, 1, 1) = Chr(&H20) Then tmpVal = Mid(tmpVal, 2, Len(tmpVal) - 1) End If Next Return WaitGo & tmpVal.ToString ElseIf Len(rxMessage) = 16 Then WaitGo = Mid(rxMessage, 3, 1) tmpVal = Mid(rxMessage, 5, 7) For i = 1 To Len(tmpVal) If Mid(tmpVal, 1, 1) = Chr(&H20) Then tmpVal = Mid(tmpVal, 2, Len(tmpVal) - 1) End If Next MeasureVal = Val(tmpVal) / 10 Return WaitGo & MeasureVal.ToString Else Exit While End If End Select CmdRet = "TIMEOUT" End While Next Return CmdRet End Function Public Function ReceiveByteSerial() As String Dim n As Integer = weightForm.cmdSerialPort.BytesToRead Dim comBuffer As Byte() Try comBuffer = New Byte(n - 1) {} weightForm.cmdSerialPort.Read(comBuffer, 0, n) For cnt = 0 To comBuffer.Length - 1 rxMessage = rxMessage & Chr(comBuffer(cnt)) Next If Mid(rxMessage, 1, 1) = ChrW(6) Then Return "START" ElseIf Len(rxMessage) > 14 Then If Mid(rxMessage, InStr(rxMessage, ChrW(1)), 2) = ChrW(1) & ChrW(2) Then rxMessage = Mid(rxMessage, InStr(rxMessage, ChrW(1)), (Len(rxMessage))) If Mid(rxMessage, InStr(rxMessage, ChrW(3)), 2) = ChrW(3) & ChrW(4) Then rxMessage = Mid(rxMessage, 1, InStr(rxMessage, ChrW(4))) Return "COMPLETE" End If End If End If Return "FAIL" Catch ex As Exception MsgBox("DataReceived," & ex.Message) Return False End Try End Function End Module