VB串口通信源程序

1、精选优质文档-倾情为你奉上Private Sub Form_Load()  '设置打开端口  If OpenPort(3) = False Then  MsgBox "串口打开失败！"  End IfEnd SubPrivate Sub Command1_Click()  Dim sBuf(2) As Byte  sBuf(0) = &H55  sBuf(1) = &H31  sBuf(2) = &HFF  If SendByte(sBuf) = Fal

2、se Then      End IfEnd Sub'收到数据产生MSComm事件Private Sub MSComm1_OnComm()  Dim i As Integer  Dim rBuf() As Byte  rBuf = MSComm1.Input  For i = 0 To UBound(rBuf)  Debug.Print rBuf(i)  Next iEnd Sub'串口初始化Private Function OpenPort(PortNum As Integer) As

3、Boolean  On Error GoTo ErrExit '出错转移到ErrExit处理  With Me.MSComm1  .CommPort = PortNum '端口号  .Settings = "9600,n,8,1" '波特率=9600bps；n(无奇偶校验)e(偶校验)o(奇校验)；8位数据位；1位停止位  .InputMode = 1 '采用二进制数据传输  .NullDiscard = False 'NULL字符从端口传送到接受缓冲区  .DTR

4、Enable = False 'DTR线无效  .EOFEnable = False '不寻找EOF符  .RTSEnable = False 'RTS线无效  .InBufferCount = 0 '清空接受缓冲区  .OutBufferCount = 0 '清空传输缓冲区  .SThreshold = 0 '不产生MSComm事件  .RThreshold = 1 '产生MSComm事件  .InputLen = 0 '当输入占用时，告诉控件读入整个缓冲区。

5、  .InBufferSize = 256 '接收缓冲区 默认为1024个字节  .OutBufferSize = 256 '发送缓冲区 默认为512个字节  .PortOpen = True '打开端口  End With  OpenPort = True '标明串口打开  Exit Function '函数结束ErrExit: '错误处理  OpenPort = False '标明串口打开失败End Function '函数结束'以二进制发送byte

6、数组Private Function SendByte(Buf() As Byte) As Boolean  On Error GoTo ErrExit '出错转移到ErrExit处理  With MSComm1  .OutBufferCount = 0 '清空接收缓冲区  .Output = Buf '发送数据  End With  SendByte = True '标明数据发送成功  Exit Function '函数结束ErrExit: '错误处理  SendB

7、yte = False '标明串口发送失败End Function  程序匠人    2005-9-22 14:23:00     | |  |  VB串口通讯实例作者：liwenzhao高精度电压表(24bit)  VB源程序Dim PortValue As Integer    '端口号选择1-4Dim value As Double        

8、; '当前一次取值Dim value2 As Double        '要显示的值Dim valueSum As Double        '和Dim numCount As Double      '算平均值是的计数个数Dim func As Integer         '功能

9、号标志1-4Dim valueFlag As Integer/*' Check1_Click()为控制Command1是否EnabledPrivate Sub Check1_Click()'自动刷新 被选中则 刷新按钮无效If Check1.value Then    Command1.Enabled = FalseElse    Command1.Enabled = True        Command1.SetFocusEnd IfEnd Sub*/*P

10、rivate Sub Command1_Click()    '显示    Call displayEnd Sub*/Private Sub Command2_Click() '复位    valueSum = 0 '清计数和    numCount = 1 '清计数个数    Label6.Caption = Str(numCount - 1) '显示复位    value

11、= 0    '当前一次取值value2 = 0    '要显示的值valueFlag = 0    Call displayEnd SubPrivate Sub Form_Activate()    numCount = 1    value = 0    valueSum = 0    PortValue = 1    Text1.Vis

12、ible = False    Label6.Caption = "0"    Option1(0).value = True    Option2(0).value = True '为什么两个都是True    Command1.SetFocus   'SetFocus是什么？Label1.Caption = Format(value2, "0.000,000")  &

13、#160;'Format为格式输出函数For i = 0 To 3        If Option2(i).value = True Then            func = i + 1        End If    Next i    Check1.value = 1&

14、#160;   'Call ComPortOpenEnd SubPublic Sub ComPortOpen() '开串口    With MSComm1        .CommPort = PortValue              '使用COM1      

15、  .Settings = "9600,N,8,1"       '设置通信口参数        .InBufferSize = 40        '设置MSComm1接收缓冲区为40字节        '.OutBufferSize = 2  

16、0;     '设置MSComm1发送缓冲区为2字节        'VB中OutBufferSize是以字符为单位的？.InputMode = comInputModeBinary        '设置接收数据模式为二进制形式        .InputLen = 1    

17、0;   'VB中InputLen单位是字符数'设置Input 一次从接收缓冲读取字节数为1        '.SThreshold = 1'VB中SThreshold单位是字符数'设置Output 一次从发送缓冲读取字节数为1        .InBufferCount = 0  '清除接收缓冲区'.OutBufferCount = 0   

18、;  '清除发送缓冲区'MaxW = -99        '最大值赋初值 ？        'MinW = 99             '最小值赋初值 ？        'w = 0  &

19、#160;     '数据个数计数器清零        .RThreshold = 1        On Error Resume Next'？        '设置接收一个字节产生OnComm事件/*'打开串口，如打不开，则Err，出现msg      

20、  If .PortOpen = False Then            '判断通信口是否打开            .PortOpen = True       '打开通信口         

21、60;  If Err Then        '错误处理                msg = MsgBox(" 串口 COM" & PortValue & " 无效！ ", vbOKOnly, "警告")'vbOKOnly显示确定按钮   

22、             Exit Sub            End If        End If*/    End With    'MsgBox "端口已打开"End SubPublic Sub Co

23、mPortClose() '关串口    MSComm1.PortOpen = False    '   MsgBox "端口已关闭"End SubPrivate Sub MSComm1_OnComm()    Call reciveEnd SubPrivate Sub Option1_Click(Index As Integer)    If MSComm1.PortOpen = True Then 

24、0;      Call ComPortClose    End If    PortValue = Index + 1    Call ComPortOpenEnd SubPrivate Sub recive() '检测起始位并接收数据    Dim Buffer As Variant    Dim Arr() As Byte    Dim inData(5

25、) As Byte    Dim count  As Integer    Dim temp As Byte    '  MsgBox "OnComm"    With MSComm1            Select Case .CommEvent      

26、;      '判断MSComm1通信事件 CommEvent ？                Case comEvReceive                    '收到Rthresho

27、ld个字节产生的接收事件                    Buffer = .Input                    Arr = Buffer     &

28、#160;              '读取一个接收字节                    ' Text1.Text = Arr(0)          

29、60;         If Arr(0) = &H1B Then                       ' &H表示是十六进制数，1B即27 ？是27.RThreshold = 0      

30、60;                 Do                            DoEvents    

31、60;                   ' DoEvents是什么？Loop Until .InBufferCount >= 4                       

32、0;'这里的4是不是应该是40                        For i = 1 To 4                     &#

33、160;      'count = .InBufferCount                            Buffer = .Input          

34、                  Arr = Buffer                            inData(i) = Arr(0)

35、0;                       Next i                        If inData(4) = &

36、HA Then                            If (inData(1) Mod 64) >= 32 Then                

37、;                .RThreshold = 1                                Exit S

38、ub                            End If                     

39、60;      valueFlag = 1                            '0.              

40、;              temp = inData(1) Mod 16                            If temp <= 7 Then  &#

41、160;                             value = inData(1) Mod 8                 &#

42、160;              value = value * 256 * 256                                value

43、 = value + Val(inData(2) * 256                                value = value + Val(inData(3)         

44、                       value = value * 3.5E-06                        

45、        'Text1.Text = Format(value, "0.000,000")                            Else      

46、                          value = inData(1) Mod 8                     

47、           value = value * 256 * 256                                value = value + Val(inData(

48、2) * 256                                value = value + Val(inData(3)            

49、0;                   value = value * 3.5E-06                           

50、0;    value = 0 - value                            End If               

51、60;            temp = inData(1) Mod 128                            ' test OF     

52、                       If temp >= 64 Then                        &#

53、160;       If value < 0 Then                                    value = value - 0. 

54、0;                              Else                    

55、;                value = value + 0.                                End

56、 If                            End If                     &#

57、160;      '检测自动刷新                            If Check1.value Then            

58、;                     'valueFlag = 1                          

59、0;      Call display                            End If              &#

60、160;         Else                            .RThreshold = 1           

61、;                 Exit Sub                        End If        &

62、#160;               .InBufferCount = 0                        .RThreshold = 1      &#

63、160;             End If            Case Else        End Select    End With    'Text1.Text = Text1.Text + 1End SubPri

64、vate Sub Option2_Click(Index As Integer)    func = Index + 1End SubPublic Sub display() '判断功能并显示        '功能选择    Select Case func        Case 1 '当前值       

65、60;    value2 = value                    Case 2 '平均值            If numCount > Then        

66、60;       numCount = 1                valueSum = 0            End If            If va

67、lueFlag = 1 Then                valueSum = valueSum + value                value2 = valueSum / numCount        

68、;        numCount = numCount + 1                valueFlag = 0                Label6.Caption = Str(numCount - 1) 

69、9;Str()为数字转换成字符串函数            End If        Case 3 '最大值            If value > value2 Then          

70、;      value2 = value            End If        Case 4 '最小值            If value < value2 Then     &

71、#160;          value2 = value            End If        Case Else    End Select    'Text1.Text = Str(valueSum)    Lab

72、el1.Caption = Format(value2, "0.000,000")    End SubPrivate Sub Timer1_Timer()'清缓冲区    ' Text1.Text = MSComm1.InBufferCount    If MSComm1.InBufferCount >= 80 Then        MSComm1.InBufferCount = 0

73、0;   End IfEnd Sub  程序匠人    2005-10-22 19:48:00     | |  |  Visual Basic串口通讯调试方法     现有电子秤一台，使用串口与计算机进行通讯。编写VB程序来访问串口，达到读取电子秤上显示的数据。该电子秤为BE01型仪表，输出为RS-232C标准接口，波特率为300-9600、偶校验、7个数据位、2个停止位。所有字符均发送11位ASCII码，一个起始位。在VB中与串口通讯需要引入

74、控件MSComm串口通讯控件（在Microsoft Comm Control 6.0中）。具体程序如下：控件简称：MSC  Dim Out(12) As Byte 接收var中的值 Dim var As Variant 接收MSC.input中的数值 Dim nRece As Integer 计算MSC.inputbuffer的个数 Dim i As Integer, j As Integer 随即变量，计算循环 * Private Sub Form_Load() ClearText With MSC .CommPort = 1 设置Com1为通信端口 .Settings = &qu

75、ot;9600,E,7,2" 设置通信端口参数 9600赫兹、偶校验、7个数据位、2个停止位.（这里需要进一步说明的是：.Setting=”BBBB,P,D,S”。 含义是：B：Baud Rate（波特率）；P：Parity（奇偶）；D：Data Bit；S：Stop Bit） .InBufferSize = 40 设置缓冲区接收数据为40字节 .InputLen = 1 设置Input一次从接收缓冲读取字节数为1 .RThreshold = 1 设置接收一个字节就产生OnComm事件 End With End Sub * Private Sub ClearText() Text3.

76、Text = "" Text2.Text = "5" Text1.Text = "" End Sub Private Sub Command1_Click() 复位并打开串口ClearText nRece = 0 计数器清零 是不是应该把前面的去掉啊？With MSC .InputMode = comInputModeBinary 设置数据接收模式为二进制形式 .InBufferCount = 0 清除接收缓冲区 If Not .PortOpen Then .PortOpen = True 打开通信端口 End If End With

77、 End Sub Private Sub MSC_OnComm() DelayTime 用来延续时间 ClearText With MSC Select Case .CommEvent 判断通信事件 Case comEvReceive: 收到Rthreshold个字节产生的接收事件 SwichVar 1 是个子过程If Out(1) = 2 Then 判断是否为数据的开始标志 .RThreshold = 0 关闭OnComm事件接收 End If Do DoEvents Loop Until .InBufferCount >= 3 循环等待接收缓冲区>=3个字节 nRece = n

78、Rece + 1 For i = 2 To 12 SwichVar i Text1.Text = Text1.Text & Chr(Out(i) Next Text1.Text = LTrim(Text1.Text) LTrim函数是将一个字符串中最前面的所有空格去掉Text2.Text = Text2.Text & CStr(nRece) CStr同Str.RThreshold = 1 打开MSComm事件接收 Case Else .PortOpen = False End Select End With End Sub * Private Sub DelayTime() D

79、im bDT As Boolean 逻辑型数据Dim sPrevious As Single, sLast As Single 单精度bDT = True sPrevious = Timer (Timer可以计算从子夜到现在所经过的秒数，在Microsoft Windows中，Timer函数可以返回一秒的小数部分) Do While bDT If Timer - sPrevious >= 0.3 Then bDT = False Loop bDT = True End Sub （通信传输速率为9600bps，则最快速度1.04ms发送一个字节，仪表每秒发送50帧数据，每帧数据有4个字节，

80、即每秒发送200个字节，平均5.0ms 发送一个字节，连续读取串口数据时要在程序中添加循环等待程序） Private Sub SwichVar(ByVal nNum As Integer) DelayTime var = Null var = MSC.Input Out(nNum) = var(0) End Sub （设置接收数据模式采用二进制形式，即 InputMode=comInputModeBinary，但用Input属性读取数据时，不能直接赋值给 Byte 类型变量，只能通过先赋值给一个 Variant 类型变量，返回一个二进制数据的数组，再转换保存到Byte类型数变量中。） Priv

81、ate Sub Text1_Change() Text3.Text = CText(Text1.Text) - CText(Text2.Text) End Sub * Private Function CText(ByVal str As String) As Currency ByVal是什么？If str <> "" Then CText = CCur(Val(str) CCur是什么？Else CText = 0 End If End Function  （仪表每秒发送50帧数据，微机收到一帧完整数据至少需要20 ms时间，然后再进行数据处理。如

82、果微机在下一帧数据接收前即20ms内能将数据计算处理完毕，则接收缓冲区内只会保存有一帧数据，不会存有两帧以上数据，接收缓冲区的大小不会影响实时监测效果（接收缓冲区>4字节），这时完全可以实现实时监测或实时控制；如果微机在20ms内不能将数据计算处理完毕，接收缓冲区设置得又很大，在数据计算处理完毕前，接收缓冲区内就会保存有两帧以上数据，而且一次工作时间越长，缓冲区内滞留数据帧就越多，数据采集和数据处理之间产生逐渐增大的额外时间差，当接收缓冲区充满后，时间差不再增大，固定在某一值，部分数据因不能及时采集到接收缓冲区中，数据产生丢失现象，真实工作情况就会和微机处理结果产生较大的时间差，对实时监

83、测和实时控制很不利，这种情况下接收缓冲区的大小就会影响实时监测效果，所以接收缓冲区设置不能过大，以保证数据处理的实时性。） 小结：本文所用的仪表为梅特勒公司出产的BE01型电子秤，其输出的每个编码均为标准的ASCII码。其他的仪表存在发射的编码中含有BCD压缩码，而且分为高低位，需要接收后对其进行解码换算，之后还要将高位和低位数字进行相加，即可以将其BCD码换算成实数。另还存在误差的可能：判断最大值，仪表在刚开始工作时有干扰，会传导一些乱码，位移传感器有参数偏差，最大值一般都略大于50毫米，所以取51为极限最大值，取51为极限最小值。暂时先写这些，当然其他的情况可以依此类推  

84、60;程序匠人    2005-10-2 14:36:00     | |  |  一个简单的VB串口发送程序（源码）！'-发送按钮Click事件子程序-Private Sub Fasong_Click()Dim JIHAO(0)    As Byte             机号Dim head_data(4) As Byte&

85、#160;          5 Byte控制字Dim end_data(0) As Byte            '1 Byte 结束字    JIHAO(0) = Val(Text3.Text)    head_data(0) = Val(Text4.Text)  

86、  head_data(2) = &HEE                 'TIMH    head_data(3) = &HEE                 '

87、TIML    head_data(4) = Val(Combo1.Text)     'INMOD    end_data(0) = &HFF    If Combo2.Text = "增加" Then head_data(1) = &H99    If Combo2.Text = "清空" Then head_data(

88、1) = &H33    If Combo2.Text = "删除" Then head_data(1) = &H32    Ready = 0: ErrCount = 0    On Error GoTo ERRORCOM              打开错误处理'-  &#

89、160;  If com1.Value Then MSComm1.CommPort = 1    'Use com1     If com2.Value Then MSComm1.CommPort = 2    'Use com2     MSComm1.Settings = FORM1.Combo3.Text + ",M,8,2"  

90、60;  '设定波特率和置校验和位为1     MSComm1.InputLen = 0                '     MSComm1.PortOpen = -1           

91、;    'Open the port     MSComm1.OutBufferCount = 0     MSComm1.Output = JIHAO              发送机号     MSComm1.PortOpen = False &

92、#160;          关闭串口     MSComm1.Settings = FORM1.Combo3.Text + ",S,8,2" '设定波特率和置校验和位为空     MSComm1.OutBufferCount = 0     MSComm1.PortOpen = True  

93、0;  MSComm1.Output = head_data     MSComm1.Output = Text2.Text     MSComm1.Output = end_data     MSComm1.PortOpen = False     Text1.Text = "发送成功!" + Chr(13) & Chr(10) + "发

94、送至" + Text3.Text + "屏体," + "信息编号:" + Text4.Text + Chr(13) & Chr(10) + Chr(13) & Chr(10) + Text1.Text     GoTo comendERRORCOM:     Text1.Text = "ERROR!请重新选择COM口!" + Chr(13) & Chr(10) + Chr(13) & Chr(1

95、0) + Text1.Textcomend:     On Error GoTo 0End Sub  程序匠人    2005-10-2 14:32:00     | |  |  贴一个非常好的串口程序！(from iccavr)(hanzhaowei)#include <iom128v.h>#include <macros.h>#include "uart.h"/* USART Buffer

96、 Defines */#define USART_RX_BUFFER_SIZE 16 /* 1,2,4,8,16,32,64,128 or 256 bytes */#define USART_RX_BUFFER_MASK ( USART_RX_BUFFER_SIZE - 1 )#define USART_TX_BUFFER_SIZE 16 /* 1,2,4,8,16,32,64,128 or 256 bytes */#define USART_TX_BUFFER_MASK ( USART_TX_BUFFER_SIZE - 1 )#if ( USART_RX_BUFFER_SIZE &

97、USART_RX_BUFFER_MASK )#error RX buffer size is not a power of 2#endif/* Static Variables */static unsigned char USART_RxBufUSART_RX_BUFFER_SIZE;static volatile unsigned char USART_RxHead;static volatile unsigned char USART_RxTail;static unsigned char USART_TxBufUSART_TX_BUFFER_SIZE;static volatile u

98、nsigned char USART_TxHead;static volatile unsigned char USART_TxTail;/* 串口初始化 */void InitUSART(INT8U  baudrate)INT8U x;UBRR0L = baudrate;UCSR0B = ( (1<<RXCIE0) | (1<<RXEN0) | (1<<TXEN0) );/*RX Complete Interrupt Enable, Receiver Enable and Transmitter Enable*/x = 0; /* fl

99、ush receive buffer */USART_RxTail = x;USART_RxHead = x;USART_TxTail = x;USART_TxHead = x;/* 接收中断 */void USART_RX_interrupt( void )unsigned char data;unsigned char tmphead;data = UDR0; /* read the received data */tmphead = ( USART_RxHead + 1 ) & USART_RX_BUFFER_MASK;/* calculate buffer index */US

100、ART_RxHead = tmphead; /* store new index */if ( tmphead = USART_RxTail )return;/* ERROR! Receive buffer overflow, you can use flux cortorl */USART_RxBuftmphead = data; /* store received data in buffer */* 发送中断 */void USART_TX_interrupt( void )unsigned char tmptail;if ( USART_TxHead != USART_TxTail )

101、/* check if all data is transmitted */tmptail = ( USART_TxTail + 1 ) & USART_TX_BUFFER_MASK;/* calculate buffer index */USART_TxTail = tmptail; /* store new index */UDR0 = USART_TxBuftmptail; /* start transmition */elseUCSR0B &= (1<<UDRIE0); /* disable UDRE interrupt */* 读取数据函数 */unsigned char ReceiveByte(