module1.bas

VB与单片机通信实现智能照明温度控制示例 包括Vb代码和C代码

Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const CMD_PING = 90
Public Const CMD_CON_LIGHT = 1
Public Const CMD_CON_AIRCON = 2
Public Const CMD_ADJ_TIMER = 3
Public Const CMD_QUERY_ROOM = &H11
Public Const CMD_QUERY_DATA = &H12
Public Const CMD_SETTIMER_POWER = &H35
Public Const CMD_ENABLE_MANUAL_CON = &H31
Public Const CMD_DISABLE_MANUAL_CON = &H33
Global g_Cancel As Boolean
Const SendDelay = 1
Global Const TIMEOUT_WAITCLIENT = 300
Global Const TIMEOUT_WAITREPLY = 300
Global Const TIMEOUT_WAITRESPONSE = 100
Public Function Recv(s() As Byte, t As Integer) As Integer
    Dim OriTime As Long
    OriTime = GetTickCount()
    
    While (t > GetTickCount() - OriTime)
        Recv = FrmMain.MSComm.InBufferCount
        If Recv > 0 Then
            Do
                Recv = FrmMain.MSComm.InBufferCount
                DoEvents
            Loop While FrmMain.MSComm.InBufferCount > Recv
            s = FrmMain.MSComm.Input
            FrmMain.MSComm.InBufferCount = 0
            If UBound(s) < 0 Then
                ReDim s(0)
                Recv = 0
                s(0) = 0
            End If
            Exit Function
        End If
        DoEvents
    Wend
End Function

Public Sub Send(i As Byte, t As Integer)
    Dim c(0) As Byte
    c(0) = i
    FrmMain.MSComm.Output = c
    Sleep t
End Sub


Public Function SendCommand(i() As Byte, ByVal Addr As Byte, Timeout As Integer) As Boolean
    Dim s() As Byte
    Dim j, RecvLen As Byte
    Send &HFF, SendDelay
    Send Addr, SendDelay
    For j = 0 To UBound(i)
        Send i(j), SendDelay
    Next j
    
    Sleep TIMEOUT_WAITRESPONSE
    
    
    RecvLen = Recv(s, Timeout)
    SendCommand = False
  
    If RecvLen = 1 Then
        If s(0) = Addr Then
            SendCommand = True
        End If
    ElseIf RecvLen > 2 Then
        If s(0) = Addr Then
            For j = 0 To Min(UBound(i), RecvLen - 2)
                i(j) = s(j + 1)
            Next j
            j = i(0)
            If CheckSum(i, j - 1) = i(j) Then
                SendCommand = True
            End If
        End If
    End If
End Function

Public Function SendGroupCmd(Cmd() As Byte, Timeout As Integer) As Boolean
    Dim i As Node
    SendGroupCmd = True
    For Each i In FrmMain.TView.Nodes
        If i.Checked = True And i.Children = 0 Then
            If Not SendCommand(Cmd, CByte(Right(i.Key, Len(i.Key) - 1)), Timeout) Then
                SendGroupCmd = False
            End If
        End If
    Next i
        
        
End Function

Public Sub GenCmd(i() As Byte, CmdType As Byte)
    Dim CmdLen As Byte
    Select Case CmdType
    Case CMD_PING
        CmdLen = 2
    Case CMD_ENABLE_MANUAL_CON
        CmdLen = 2
    Case CMD_DISABLE_MANUAL_CON
        CmdLen = 2
    Case CMD_QUERY_ROOM
        CmdLen = 2
    Case CMD_QUERY_DATA
        CmdLen = 2
    Case CMD_CON_LIGHT
        CmdLen = 3
    Case CMD_CON_AIRCON
        CmdLen = 3
    Case CMD_ADJ_TIMER
        CmdLen = 5
    Case CMD_SETTIMER_POWER
        CmdLen = 6
    End Select
    i(0) = CmdLen
    i(1) = CmdType
    i(CmdLen) = CheckSum(i, CmdLen - 1)
End Sub

Public Function Min(i As Integer, j As Integer) As Integer
    If i < j Then
        Min = i
    Else
        Min = j
    End If
End Function
Public Function CheckSum(i() As Byte, Length As Byte) As Byte
    Dim j As Integer
    CheckSum = 0
    For j = 0 To Length
        CheckSum = CheckSum Xor i(j)
    Next
    If CheckSum = &HFF Then
        CheckSum = &HFE
    End If
    
End Function