程序.txt

该程序是实现蓝牙串口通信的

打开串口：

Public Function OpenH4(OCommPort As Integer, OSetting As String, SBSize As Integer, RBSize As Integer) As Long
Dim StrBR As String

On Error GoTo OpenError

If W_frmH4 = True Then
    FrmH4.Caption = BTProtocol & "(" & GetSettings("Settings") & ")"
End If

If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
End If

If RBSize < 1024 Then
    RBSize = 1024
End If
If SBSize < 1024 Then
    SBSize = 1024
End If
If RBSize > 32766 Then
    RBSize = 32766
End If
If SBSize > 32766 Then
    SBSize = 32766
End If

With MSComm1
    .InBufferSize = RBSize
    .OutBufferSize = SBSize
    .CommPort = OCommPort
    .Settings = OSetting
    .PortOpen = True
    
    .RTSEnable = True
    .RThreshold = 1
    .InputLen = 1
    .InBufferCount = 0
    .InputMode = comInputModeBinary
End With

For I = 1 To Len(OSetting)
    If Mid(OSetting, I, 1) < Chr(&H30) Or Mid(OSetting, I, 1) > Chr(&H39) Then
        Exit For
    End If
    StrBR = StrBR & Mid(OSetting, I, 1)
Next I

If W_frmH4 = True Then
    FrmH4.Caption = BTProtocol & "(" & "COM" & GetSettings("CommPort") & "," & GetSettings("Settings") & ")"
End If

'打开串口成功

tmrGBP.Enabled = True
OpenH4 = 0
Exit Function

OpenError:
'打开串口失败
tmrGBP.Enabled = False
OpenH4 = Err.Number
If W_frmH4 = True Then
    FrmH4.Caption = BTProtocol & "(关闭," & GetSettings("Settings") & ")"
End If

End Function

MSCOMM控件处理：

Private Sub MSComm1_OnComm()
Static OnCommBusy As Boolean

Select Case MSComm1.CommEvent
   ' Handle each event or error by placing
   ' code below each case statement

' 错误
      Case comEventBreak   ' 收到 Break。
        Err.Clear
        
      Case comEventCDTO   ' CD (RLSD) 超时。
      Case comEventCTSTO   ' CTS Timeout。
      Case comEventDSRTO   ' DSR Timeout。
      Case comEventFrame   ' Framing Error
      Case comEventOverrun   '数据丢失。
      Case comEventRxOver '接收缓冲区溢出。
        MSComm1.InBufferCount = 0
'        AddStrToRTB "接收缓冲区溢出 !" + Chr(10), RGB(50, 0, 0)
      Case comEventRxParity ' Parity 错误。
      Case comEventTxFull   '传输缓冲区已满。
'        MsgBox "发送缓冲区已满", vbOKOnly, "警告"
      Case comEventDCB   '获取 DCB] 时意外错误

   ' 事件
      Case comEvCD   ' CD 线状态变化。
      Case comEvCTS   ' CTS 线状态变化。
      Case comEvDSR   ' DSR 线状态变化。
      Case comEvRing   ' Ring Indicator 变化。
      Case comEvReceive   ' 收到 RThreshold # of chars.
        If OnCommBusy = False Then
            OnCommBusy = True
            Get_BlueTooth_Packet
            OnCommBusy = False
        End If
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
   End Select

End Sub