那位高手做过用VB的COMM控件做通过串口接收短信息

1、那位高手做过用vb的comm控件做通过串口接收短信息？请指点！楼主redata（风之子）2002-01-18 09:35:01 在 VB / 非技术类 提问我的源程序     Const   COM_IN_BUF_SIZE   =   1024     Dim   ComInBuffer(COM_IN_BUF_SIZE)   As   Variant,   ComInHeadPtr   As   Integer,   ComInTailPtr  

2、 As   Integer,   ComInBufCount   As   Integer     Dim   ComInTimerOut   As   Boolean             Private   Sub   InitPort()                         MSComm1

3、.CommPort   =   1   '选用com1串行口                         MSComm1.Settings   =   "9600,n,8,1"   '波特率9600，无奇偶校验位，8位数据位1位停止位                     &#

4、160;   MSComm1.InputLen   =   1   '读取input接收缓冲区全部字节                         MSComm1.InBufferSize   =   1024   '设置接收缓冲区的字节长度                    

5、60;   MSComm1.InBufferCount   =   0   '清除发送缓冲区数据                         MSComm1.OutBufferCount   =   0   '清除接收缓冲区数据                      

6、60; MSComm1.InputMode   =   1   '输入模式为binary                         MSComm1.RThreshold   =   1   '控件收到数据时将触发OnComm事件                        

7、MSComm1.Handshaking   =   2   '握手协议      End   Sub     Private   Sub   InitComInBuf()                         ComInBufCount   =   0           

8、0; ComInHeadPtr   =   0             ComInTailPtr   =   0                         ComInTimer.Enabled   =   False             ComInTimer.Interval  

9、 =   5000             ComInTimerOut   =   False         End   Sub     Private   Sub   InitRecieve()             MSComm1.PortOpen   =   True         &#

10、160;       End   Sub         Private   Sub   RunComInHandle()                         Do   While   MSComm1.PortOpen   =   True             &

11、#160;                   If   ComInBufCount   >   0   Then                             ComInHandle                   &

12、#160; End   If                                         DoEvents                                 Loop    

13、            End   Sub         Private   Sub   ComInHandle()                         Dim   InByte   As   Byte             Dim  

14、; InPack(COM_IN_BUF_SIZE)   As   Byte,   InPackCount   As   Integer                                 Do   While   ComInByte(InByte)   =   True          

15、;               If   InByte   =   &HD   Then                             Call   InPackHandle(InPack(),   InPackCount)             &

16、#160;               Exit   Sub                     Else                             InPack(InPackCount)   =   InByte    

17、                         InPackCount   =   InPackCount   +   1                     End   If                    

18、60;                   Loop                 End   Sub     Private   Function   ComInByte(ByRef   InByte   As   Byte)   As   Boolean     '接收一个字节   &

19、#160;         If   ComInBufCount   >   0   Then                                 InByte   =   ComInBuffer(ComInTailPtr)              

20、       ComInBufCount   =   ComInBufCount   -   1                     ComInTailPtr   =   (ComInTailPtr   +   1)   Mod   COM_IN_BUF_SIZE               &

21、#160;     ComInByte   =   True                     p_addlist1   "收到回应A->"   &   Hex(InByte)   &   ""                    

22、60;   Else                                 ComInTimer.Enabled   =   True                     ComInTimerOut   =   False        

23、;                                 Do   While   ComInTimerOut   =   False                             If   ComInBufCount  

24、; >   0   Then                                     If   ComInBufCount   >   COM_IN_BUF_SIZE   Then                      

25、;                       p_addlist1   "内存缓冲区溢出"                                     End   If             &

26、#160;                       ComInTimer.Enabled   =   False                                     InByte   =   ComInBuffer(ComInTailPtr) &

27、#160;                                   ComInBufCount   =   ComInBufCount   -   1                                 &

28、#160;   ComInTailPtr   =   (ComInTailPtr   +   1)   Mod   COM_IN_BUF_SIZE                                     ComInByte   =   True          

29、                           p_addlist1   "收到回应B->"   &   Hex(InByte)   &   ""                             

30、0;       Exit   Function                             Else                                     DoEvents    

31、60;                       End   If                     Loop                                     

32、0;   ComInTimer.Enabled   =   False                     ComInByte   =   False             End   If     End   Function         Private   Sub   Com

33、InTimer_Timer()             ComInTimeOut   =   True     End   Sub                 Private   Sub   MSComm1_OnComm()             Dim   InVar   As   Vari

34、ant             Dim   InArr()   As   Byte                         If   MSComm1.CommEvent   =   comEvReceive   Then   '   事件信息          

35、          Do   While   MSComm1.InBufferCount   >   0                             InVar   =   MSComm1.Input                   &#

36、160;         InArr   =   InVar                             ComInBuffer(ComInHeadPtr)   =   InArr(0)                          

37、   ComInBufCount   =   ComInBufCount   +   1                             ComInHeadPtr   =   (ComInHeadPtr   +   1)   Mod   COM_IN_BUF_SIZE           &

38、#160;         Loop             End   If     End   Sub     Private   Sub   InPackHandle(InPack()   As   Byte,   ByVal   InPackCount   As   Integer)     Dim   InPackSt

39、r   As   String     '#             InPackStr   =   InPack             List2.AddItem   InPackStr             'InPackStr   =   StrConv(MidB(InPack,   1, &

40、#160; InPackCount),   vbUnicode)             'Call   AddRecieveToList(ListRecieve,   InPackStr)             'Call   AddRecieveToDb(InPackStr)     End   Sub         Private  

41、; Sub   p_addlist1(str   As   String)             If   List1.ListCount   >   500   Then                     List1.RemoveItem   0             End &#

42、160; If               List1.AddItem   Format(LineCount,   "0")   &   "."   &   str               LineCount   =   LineCount   +   1      

43、        List1.Selected(List1.ListCount   -   1)   =   True     End   Sub     Private   Sub   Form_Load()             InitPort             InitComInBuf    

44、        InitRecieve             RunComInHandle                 End   Sub     Private   Sub   Form_Unload(Cancel   As   Integer)             MSCom

45、m1.PortOpen   =   False             End     End   Sub   If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False                             &

46、#160;                           MSComm1.CommPort   =   1     '假定是用COM1口                                        

47、                 '   设定传输速率等，可依照您的需求更改                             MSComm1.Settings   =   "9600,N,8,1"                 &#

48、160;                 MSComm1.PortOpen   =   True                             '-初始化Modem-                   MSComm1.Output   =

49、  "ATZ"                   MSComm1.Output   =   "AT&F"                   MSComm1.Output   =   "ATE0"               &#

50、160;   MSComm1.Output   =   "ATM1"                   MSComm1.Output   =   "ATQ0"                   MSComm1.Output   =   "ATV0"     

51、0;   '-拨号-     MSComm1.Output   ="ATDT163"       '拨163     '-接通后     MSComm1.Output   ="SDFJDKSJLKFA"       '发送字符串         '-     Private   Sub  

52、 MSComm1_OnComm()               '用串口事件捕捉数据.             If   MSComm1.InBufferCount   Then                           '   通讯埠中假如有资料的话,   则读取进来 &

53、#160;                       InStringB   =   InStringB   &   MSComm1.Input                         '   如果资料中有   Chr(13)   和   Chr(10) 

54、0; 的话,   则显示出来                                   If   InStr(InStringB,   vbCrLf)   Then                               &#

55、160;           instring   =   instring   &   InStringB                                                        

56、                            AddText   Text3,   InStringB,   False                                           &#

57、160;                                         InStringB   =   ""                                 

58、0; End   If                           End   If     END   SUB         '-挂断-     MSComm1.PortOpen   =   False         '这个挂断方法不能适用所有MODEM,我正在研究.通

59、用办法实现16进制接收实质就是按2进制接收 设置MSComm控件的属性InputMode = comInputModeBinary '二进制接收 接收后由HEX函数转为16进制字符串形式显示 Option Explicit Dim strData As String Dim bytInput() As Byte Private Sub MsComm1_OnComm() Dim intInputLen As Integer Select Case Me.MSComm2.CommEvent Case comEvReceive '此处添加处理接收的代码 MSComm1.InputMo

60、de = comInputModeBinary '二进制接收 intInputLen = MSComm1.InBufferCount ReDim bytInput(intInputLen) bytInput = MSComm1.Input jieshou End Select End Sub Public Function jieshou() '接收数据处理为16进制 Dim i As Integer For i = 0 To UBound(bytInput) If Len(Hex(bytInput(i) = 1 Then strData = strData & &qu

61、ot;0" & Hex(bytInput(i) Else strData = strData & Hex(bytInput(i) End If Next Text1 = strData End Function Private Sub Form_Load() MSComm1.CommPort = 1 MSComm1.InBufferSize = 1024 MSComm1.OutBufferSize = 512 MSComm1.Settings = "9600,n,8,1" MSComm1.PortOpen = True Text1 = "

62、" End Sub接受 Buffer = MSComm1.Input ' 接收一个二进制数据 Arr(0) = AscB(Buffer) '存入到二进制数组数组中 Receive_Count_Byte = Receive_Count_Byte + 1 Real_Receive = Arr(0) ' Text1.Text = Text1.Text & Real_Receive & " " '接收的数据显示到文本框中一个server端 Private Sub Command1_Click() End End Sub Pr

63、ivate Sub Command2_Click() Winsockserver.SendData Text4.Text + ":" + textsend.Text textget.Text = textget.Text + vbCrLf + Text4.Text + ":" + textsend.Text + " " + Str(Time) textsend.Text = "" End Sub Private Sub Form_Load() Command2.Visible = False textsend.Vi

64、sible = False Text4.Visible = False textget.Visible = False Label1.Visible = False Winsockserver.LocalPort = 1001 Winsockserver.Listen End Sub Private Sub textsend_Change() 'Winsockserver.SendData textsend.text End Sub Private Sub textsend_KeyPress(KeyAscii As Integer) 'If KeyAscii = 13 Then

65、 'Winsockserver.SendData textsend.text 'textsend.text = "" If KeyAscii = 13 Then Winsockserver.SendData textsend.Text ' Text1.text = Text1.text + vbCrLf + Text4.text + ": " + Text2.text + " " + Str(Time) textsend.Text = "" End If End Sub Private Su

66、b Timer1_Timer() If Text4.Text = "" Then Text4.Text = "no name" End Sub Private Sub Winsockserver_Close() Winsockserver.Close End End Sub Private Sub Winsockserver_ConnectionRequest(ByVal requestID As Long) Command2.Visible = True textsend.Visible = True textget.Visible = True Te

67、xt4.Visible = True Label1.Visible = True If Winsockserver.State <> sckClosed Then Winsockserver.Close Winsockserver.Accept requestID End Sub Private Sub Winsockserver_DataArrival(ByVal bytesTotal As Long) Dim tmpstr As String Winsockserver.GetData tmpstr 'textget.text = textget + tmpstr +

68、textsend textget.Text = textget.Text + vbCrLf + tmpstr + " " + Str(Time) End Sub '（1）Command1：退出按钮； '（2）textsend：发送数据文本框； '（3）Winsockserver： 服务器Winsock； '（4）textget ：接收数据文本框。 一个client端 Private Sub Command1_Click() End End Sub Private Sub Command2_Click() On Error Resume Nex

69、t Winsockclient.RemoteHost = Text1.Text Winsockclient.Connect End Sub Private Sub Command3_Click() Winsockclient.SendData Text4.Text + ":" + textsend.Text textget.Text = textget.Text + vbCrLf + Text4.Text + ":" + textsend.Text + " " + Str(Time) textsend.Text = "&qu

70、ot; End Sub Private Sub Form_Load() Command3.Visible = False textsend.Visible = False Text4.Visible = False textget.Visible = False Label2.Visible = False Label3.Visible = False Command2.Enabled = True Winsockclient.RemoteHost = "11" Winsockclient.RemotePort = 1001 Winsockclient

71、.RemoteHost = "sccdsz" End Sub Private Sub Text1_Change() Command2.Enabled = True 'Winsockclient.RemoteHost = Text1.Text End Sub Private Sub textsend_Change() 'Winsockclient.SendData textsend.Text End Sub Private Sub textsend_KeyPress(KeyAscii As Integer) 'If KeyAscii = 13 Then

72、 'Winsockclient.SendData textsend.Text 'textsend.Text = "" If KeyAscii = 13 Then Winsockclient.SendData Text4.Text + ":" + textsend.Text textsend.Text = "" 'End If End If End Sub Private Sub Timer1_Timer() On Error Resume Next Winsockclient.Connect Winsockcl

73、ient.RemoteHost = Text1.Text End Sub Private Sub Winsockclient_Close() Winsockclient.Close End End Sub Private Sub winsockclient_Connect() textsend.Visible = True textget.Visible = True Label2.Visible = True Label3.Visible = True Text4.Visible = True Command2.Enabled = True Command2.Visible = True C

74、ommand3.Visible = True End Sub Private Sub winsockclient_DataArrival(ByVal bytesTotal As Long) Dim tmpstr As String Winsockclient.GetData tmpstr textget.Text = textget.Text + vbCrLf + tmpstr + " " + Str(Time) End Sub '（1）Command1：退出按钮； '（2）Command2：连接按钮； '（3）Winsockclient：客户Win

75、sock； '（4）Text1：主机名文本框； '（5）Textsend：发送数据文本框； '（6）Textget：接收数据文本框； 客户机程序的界面如图所示。送数据，然后在另外一个过程里实时检测此串行口以便一旦此串行口的发送缓冲区有数据就显示消息，如果发送空数据就会显示 "无数据的字样 "。界面如下： <IMG onerror= "this.src='/book/UploadPic/2007-1/20071122959301.jpg' " hspace=3 src= "/book/UploadPi

76、c/2007-1/20071122959301.jpg " align=center vspace=1 border=1> 主要核心代码如下： Private Sub Command1_Click() If Text1.Text = " " Then List1.AddItem "发送缓冲区无数据 " Exit Sub End If MSComm1.Output = Text1.Text End Sub Private Sub Command2_Click() Unload Me End Sub '主要进行串口的初始化 Priva

77、te Sub Form_Load() '选择com1 MSComm1.CommPort = 1 '设置波特率为9.6kpbs，没有奇偶校验，8位数据位，1位结束位 MSComm1.Settings = "9600,N,8,1 " '读取全部的输入缓冲区 MSComm1.InputLen = 0 '端口打开 MSComm1.PortOpen = True MSComm1.RThreshold = 10 MSComm1.SThreshold = 10 '以下就可以进行数据的发送了 End Sub '所有的通讯事件都可以激发MSCo

78、mm1控件的OnComm事件 Private Sub MSComm1_OnComm() Select Case MSComm1.CommEvent Case comEvReceive '此处的代码可以进行当串口的接受缓冲区里有RThreshold个字符的处理 Case comEvSend '此处的代码可以进行当串口的发送缓冲区里有SThreshold个字符的处理 List1.AddItem "发送缓冲区有数据 " End Select End Sub急！求助：vb串口通信我的串口数据传送显示总是有问题：提示数据类型不匹配或者就没有数据显示出来请各位大侠帮帮忙

79、啊！Dim var As VariantPrivate Sub Comm1_OnComm()Select Case Comm1.CommEventCase comEvReceive  var = Hex(Asc(Comm1.Input) Text1.Text = Text1.Text + var + " "End SelectEnd SubPrivate&#

80、160;Sub Form_Load()'a = 123 Text2.Text = "Comm1.CommPort = 1"Comm1.CommPort = 1Comm1.Settings = "1200,N,8,1"Comm1.InputMode = comInputModeBinaryComm1.InputLen = "0"Comm1.InBufferSize

81、0;= 1024Comm1.OutBufferSize = 512Comm1.PortOpen = TrueComm1.SThreshold = 0Comm1.RThreshold = 1Comm1.InBufferCount = 0Comm1.OutBufferCount = 0End Sub   回复内容【zdingyun】:Private Sub MSComm1_OnComm()  

82、;  On Error Resume Next    Dim BytesReceived() As Byte    Dim buffer As String    Dim HData As String    Dim i As Integer  &#

83、160; Select Case MSComm1.CommEvent        Case comEvReceive               '接收十六进制数据。并以十六进制显示           

84、60;MSComm1.InputLen = 0            buffer = MSComm1.Input                  '接收数据至字符串中       

85、;     BytesReceived() = buffer                '将数据转入Byte数组中            For i = 0 To UBound(Bytes

86、Received)      '显示结果以十六进制显示                If Len(Hex(BytesReceived(i) = 1 Then              

87、60;     HData = HData & "0" & Hex(BytesReceived(i)                Else             

88、;       HData = HData & Hex(BytesReceived(i)                End If               

89、 Text1.Text = HData                '最后将结果后入Text1中                MSComm1.OutBufferCount = 0   &#

90、160;  '清除发送缓冲区                MSComm1.InBufferCount = 0       '清除接收缓冲区            Next  

91、;  End SelectEnd Sub【snowwindrainbow】:这位大侠太谢谢了！不过我还有些问题不大明白：BytesReceived这个数组是用来限制接收到的数据的个数的吗？ Len(Hex(BytesReceived(i) = 1 是用来做什么的啊？为何我只能接收到前面个数据呢后面的就没有显示了啊？【zdingyun】:16进制显示是按00-FF显示的,当Byte数值在0-15时,得到16进制数为0-F,采用下句判断:Len(Hex(BytesReceived(i) = 1使得到

92、的0-F变为00-0F为何我只能接收到前面个数据,检查下位机一次发送数据字节长度.将MSComm控件属性RThreshold 设置为下位机一次发送数据字节长度【of123】:Dim var As VariantDim tmp() As Byte, i As LongPrivate Sub Comm1_OnComm()  Select Case Comm1.CommEvent    Case

93、0;comEvReceive       var = Comm1.Input       tmp = var       For i = 0 To Ubound(tmp)         Text1.Text&

94、#160;= Text1.Text + Right("0" & Hex(tmp(i), 2) + " "       Next i  End SelectEnd Sub【of123】:Comm1.InputLen = 0    '"0"为何我只能接收到前

95、面个数据呢后面的就没有显示了啊？因为你设置了 Comm1.RThreshold = 1，在接收到第一个字节时事件就触发了。PC 的处理速度远大于串口传输速度，后面的数据还没有传过来。解决的方法：1 如果你的下位机传输的数据长度固定，可以将 Comm1.RThreshold 按楼上所述设置。2 如果数据长度不确定，可以延时足够长度再取数据。缺点是短数据也要等较长时间。3 更改你的传输协议，数据打包，也就是在数据前附加包起始标志和包长度字段（包头）。接收端 InputLen 先设置为包头长度，得到数据长度后，重新设置 InputLen 并循环检查接收缓冲区当前接收到的数据长度 InBufferCount，达到预期值后开始从 Input 取数据。比较完备的还要设置超时，防止死循环；以及协议包尾校验码，检查数据传输错误。【snowwindrainbow】:另外还有一个问题，我从串口接收到的数据怎样转存到一个数组里面去啊然后在另外一个窗体里面显示出来啊【snowwindrainbow】:我接收到的数据是11位的，那Comm1.RThreshold