module2.bas

一个用PIC做的无线点菜系统的系统

Attribute VB_Name = "Module2"
Dim tempstr As String
Dim buffers(1024) As Byte
Dim BufferCount As Long
Dim Receivedata(1024) As String                '从串口收到的数据和数量
Dim ReceiveNum As Integer

Public Sub MscommInit()

frmMain.MSComm1.PortOpen = True
BufferCount = 0
ReceiveNum = 0
Buffer = ""
End Sub



Public Function Getdata2() As String

Dim buf() As Byte
Dim Buffer() As Byte
Dim j As Long
Dim i As Long
Dim InputLength As Integer

Dim num As Integer

Static tempstr As String
Dim tempstr1 As String
Dim SendtoDatabase As String

'On Error GoTo e1
Static BufferT As Long
'Do While MSComm1.InBufferCount <> 0
'    j = MSComm1.InBufferCount
'    buf = MSComm1.Input
'    buffer = buf
'    For i = 0 To UBound(buffer)
'        buffers(BufferCount + i) = buf(i)
'    Next i
'    tempstr = ""
'    BufferCount = BufferCount + j
'    For i = 0 To BufferCount - 1
'        tempstr = tempstr & Hex(buffers(i)) & ","
'    Next i
'    Text1.Text = tempstr
'
'Loop
    
    SendtoDatabase = ""

    buf = frmMain.MSComm1.Input
    Buffer = buf


 
    
    For i = 0 To UBound(Buffer)
    
        tempstr = tempstr & Format(Hex(Buffer(i)), "00")
    Next i


    If InStr(tempstr, "B3") = 1 Then                '去掉开始标志
        tempstr1 = Right$(tempstr, Len(tempstr) - 2)
    End If
    
    num = ReceiveNum
    
    If InStr(tempstr1, "B3") <> 0 Then '数据结束
        'tempstr1 = Left$(tempstr, InStr(tempstr, "B3") - 1)
        SeeData (tempstr)
        If num <> ReceiveNum Then tempstr = Right$(tempstr, Len(tempstr) - Len(tempstr1))
    Else
        If Len(tempstr) >= 30 Then
        'tempstr1 = Left$(tempstr, 30)
        SeeData (tempstr)
        If num <> ReceiveNum Then tempstr = Right$(tempstr, Len(tempstr) - 30)
        End If
    End If



If ReceiveNum <> num Then
    For i = num To ReceiveNum - 1
        For j = 0 To 3
             SendtoDatabase = SendtoDatabase & Receivedata(i * 4 + j)
        Next j
    Next i
End If

Getdata2 = SendtoDatabase

SendtoDatabase = ""
ReceiveNum = 0

Exit Function
e1:
Debug.Print Err.Number
Stop
End Function

Private Sub SeeData(tempstr)


Dim flag(3) As Integer                  'flag(0)表示现在正在处理第几行，flag(1，2，3)表示要在这行写入第几位


Dim temp1(11) As String

Dim i, j, temp0, strLength As Integer
Dim AvaliableNumber As Integer          '可用数据有几个
Dim AvaliableNo As Integer              '可用数据用第几个



strLength = Len(tempstr)




For j = 0 To (Len(tempstr) / 2) - 1

    For i = 0 To 3
    flag(i) = 0
    Next i
    
    For i = 0 To 11
    temp1(i) = 0
    Next i

    For i = 0 To 14
       
       Select Case Mid(tempstr, 2 * i + 1, 2)          '判断是否有开始信号
            Case "B3"
                 If flag(0) <> 0 Then
                    j = j - 1
                    Exit For
                 Else
                    flag(0) = 1                          '准备往第一组数据的第一位赋值
                    flag(1) = 0
                    GoTo lineend
                End If
                
            Case "B2"
                 If flag(0) > 1 Then
                    j = j - 1
                    Exit For
                 Else
                    flag(0) = 2                          '准备往第二组数据的第一位赋值
                    flag(2) = 0
                    GoTo lineend
                 End If
                 
            Case "B1"
                 If flag(0) > 2 Then
                    j = j - 1
                    Exit For
                 Else
                    flag(0) = 3                          '准备往第三组数据的第一位赋值
                    flag(3) = 0
                    GoTo lineend
                 End If
       End Select
       
       Select Case flag(0)                      '将要赋值的地址付给temp0
            Case 0
                'i = i - 1
                GoTo lineend                    '一开始的值不是有效值
            Case 1
                temp0 = flag(1)
            Case 2
                temp0 = flag(2)
            Case 3
                temp0 = flag(3)
        End Select
       
       If temp0 = 4 Then GoTo lineend       '如果有连续超过4个数据,后面的丢弃
       
       temp1(((flag(0) - 1)) * 4 + temp0) = Mid(tempstr, 2 * i + 1, 2) '赋值给对应的地址
           
        Select Case flag(0)                      '地址偏移量+1
            Case 1
                flag(1) = flag(1) + 1
            Case 2
                flag(2) = flag(2) + 1
            Case 3
                flag(3) = flag(3) + 1
        End Select
        
       
lineend:
    j = j + 1
    If j >= Len(tempstr) Then Exit For
    

    Next i

       
    AvaliableNumber = 0
    If flag(1) = 4 Then AvaliableNumber = AvaliableNumber + 1
    If flag(2) = 4 Then AvaliableNumber = AvaliableNumber + 1
    If flag(3) = 4 Then AvaliableNumber = AvaliableNumber + 1

    
    AvaliableNo = 0
    Select Case AvaliableNumber
        Case 0
            
        Case 1, 2                               '如果是1，只有一个会是4‘如果是2，取后一个
            If flag(1) = 4 Then AvaliableNo = 1
            If flag(2) = 4 Then AvaliableNo = 2
            If flag(3) = 4 Then AvaliableNo = 3
        Case 3                                  '如果是3，取后面两个相同的
            j = j - 1                           '三个都读全，要后退一步
            AvaliableNo = 3
            For i = 0 To 3                          '判断第一组和第二组是否相同
                If temp1(i) <> temp1(4 + i) Then Exit For
            Next i
            
            If i = 4 Then AvaliableNo = 1
    End Select
    
    Select Case AvaliableNo
        Case 0
        Case 1
            For i = 0 To 3
                Receivedata(4 * ReceiveNum + i) = temp1(i)
            Next i
        Case 2
            For i = 0 To 3
                Receivedata(4 * ReceiveNum + i) = temp1(i + 4)
            Next i
        Case 3
            For i = 0 To 3
                Receivedata(4 * ReceiveNum + i) = temp1(i + 8)
            Next i
    End Select

    If AvaliableNo <> 0 Then ReceiveNum = ReceiveNum + 1
    
Next j
    flag(0) = 0

End Sub


'返回字符串 datas 中的 第一个以字符 chr$(spa) 分割的子串，并从datas中删除
Public Function GetData(ByRef datas As String, ByVal spa As Byte) As String
    Dim i As Integer
    i = 1
    Do While Mid$(datas, i, 1) <> Chr$(spa) And i < Len(datas)
        i = i + 1
    Loop
    If i < Len(datas) Then
        GetData = Left$(datas, i - 1)
        datas = Right$(datas, Len(datas) - i)
    Else
        If Right$(datas, 1) = Chr$(spa) Then
            GetData = Left$(datas, Len(datas) - 1)
        Else
            GetData = datas
        End If
        datas = ""
    End If
End Function