vb给单片机发数据问题.txt

用VB的MSCOMM给单片机发十六进制的数11

用VB的MSCOMM给单片机发十六进制的数11，单片机收到后把11送过来，用VB的text显示，请问高手怎么编写VB的程序，谢谢！
问题补充：是一秒钟发送一个数据11




Option Explicit 
Dim intTime As Integer 
Private strSendText As String '发送文本数据 
Private bytSendByte() As Byte '发送二进制数据 
Private blnReceiveFlag As Boolean 
Private blnAutoSendFlag As Boolean 
Private intPort As Integer 
Private strSet As String 
Private intReceiveLen As Integer 
Private bytReceiveByte() As Byte 
Private strAscii As String '设置初值 
Private strHex As String 
Private intHexWidth As Integer 
Private intLine As Integer 
Private m As Integer 
Private strAddress As String 
'字符表示的十六进制数转化为相应的整数,错误则返回 -1 
Function ConvertHexChr(str As String) As Integer 
Dim test As Integer 
test = Asc(str) 
If test >= Asc("0") And test <= Asc("9") Then 
test = test - Asc("0") 
ElseIf test >= Asc("a") And test <= Asc("f") Then 
test = test - Asc("a") + 10 
ElseIf test >= Asc("A") And test <= Asc("F") Then 
test = test - Asc("A") + 10 
Else 
test = -1 '出错信息 
End If 
ConvertHexChr = test 
End Function 

'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数 
Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer 
Dim HexData As Integer '十六进制(二进制)数据字节对应值 
Dim hstr As String * 1 '高位字符 
Dim lstr As String * 1 '低位字符 
Dim HighHexData As Integer '高位数值 
Dim LowHexData As Integer '低位数值 
Dim HexDataLen As Integer '字节数 
Dim StringLen As Integer '字符串长度 
Dim Account As Integer 
Dim n As Integer 
'计数 
'txtSend = "" '设初值 
HexDataLen = 0 
strHexToByteArray = 0 
StringLen = Len(strText) 
Account = StringLen \ 2 
ReDim bytByte(Account) 
For n = 1 To StringLen 
Do '清除空格 
hstr = Mid(strText, n, 1) 
n = n + 1 
If (n - 1) > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
Loop While hstr = " " 
Do 
lstr = Mid(strText, n, 1) 
n = n + 1 
If (n - 1) > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
Loop While lstr = " " 
n = n - 1 
If n > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
HighHexData = ConvertHexChr(hstr) 
LowHexData = ConvertHexChr(lstr) 

If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化 
HexDataLen = HexDataLen - 1 
Exit For 
Else 
HexData = HighHexData * 16 + LowHexData 
bytByte(HexDataLen) = HexData 
HexDataLen = HexDataLen + 1 
End If 
Next n 
If HexDataLen > 0 Then '修正最后一次循环改变的数值 
HexDataLen = HexDataLen - 1 
ReDim Preserve bytByte(HexDataLen) 
Else 
ReDim Preserve bytByte(0) 
End If 
If StringLen = 0 Then '如果是空串,则不会进入循环体 
strHexToByteArray = 0 
Else 
strHexToByteArray = HexDataLen + 1 
End If 
End Function 

Private Sub cmdManualSend_Click() 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Call ctrTimer_Timer 
If Not blnAutoSendFlag Then 
Me.MSComm.PortOpen = False 
End If 
End Sub 
Private Sub cmdAutoSend_Click() 
If blnAutoSendFlag Then 
Me.ctrTimer.Enabled = False 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
Me.cmdAutoSend.Caption = "自动发送" 
Else 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.ctrTimer.Interval = intTime 
Me.ctrTimer.Enabled = True 
Me.cmdAutoSend.Caption = "停止发送" 
End If 
blnAutoSendFlag = Not blnAutoSendFlag 
End Sub 

Private Sub ctrTimer_Timer() 
Dim longth As Integer 
strSendText = Me.txtSend.Text 
longth = strHexToByteArray(strSendText, bytSendByte()) 
If longth > 0 Then 
Me.MSComm.Output = bytSendByte 
End If 
End Sub 
'输入处理,处理接收到的字节流,并保存在全局变量 
Private Sub InputManage(bytInput() As Byte, intInputLenth As Integer) 
Dim n As Integer '定义变量及初始化 
ReDim Preserve bytReceiveByte(intReceiveLen + intInputLenth) 
For n = 1 To intInputLenth Step 1 
bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1) 
Next n 
intReceiveLen = intReceiveLen + intInputLenth 
End Sub 

'为输出准备文本,保存在全局变量 
'总行数保存在intLine 
Public Sub GetDisplayText() 
Dim n As Integer 
Dim intValue As Integer 
Dim intHighHex As Integer 
Dim intLowHex As Integer 
Dim strSingleChr As String * 1 
Dim intAddress As Integer 
Dim intAddressArray(8) As Integer 
Dim intHighAddress As Integer 
strAscii = "" '设置初值 
strHex = "" 
strAddress = "" 
'获得16进制码和ASCII码的字符串 
For n = 1 To intReceiveLen 
intValue = bytReceiveByte(n - 1) 
If intValue < 32 Or intValue > 128 Then '处理非法字符 
strSingleChr = Chr(46) '对于不能显示的ASCII码, 
Else '用"."表示 
strSingleChr = Chr(intValue) 
End If 
strAscii = strAscii + strSingleChr 
intHighHex = intValue \ 16 
intLowHex = intValue - intHighHex * 16 
If intHighHex < 10 Then 
intHighHex = intHighHex + 48 
Else 
intHighHex = intHighHex + 55 
End If 
If intLowHex < 10 Then 
intLowHex = intLowHex + 48 
Else 
intLowHex = intLowHex + 55 
End If 
strHex = strHex + Chr$(intHighHex) + Chr$(intLowHex) + " " 
If (n Mod intHexWidth) = 0 Then 
strAscii = strAscii + Chr$(13) + Chr$(10) 
strHex = strHex + Chr$(13) + Chr$(10) 
Else 
End If 
Next n 
txtAsc = strAscii 'Ascii 
txtHex = strHex '16进制 
'获得地址字符串 
intLine = intReceiveLen \ intHexWidth 
If (intReceiveLen - intHexWidth * intLine) > 0 Then 
intLine = intLine + 1 
End If 
'设置换行 
For n = 1 To intLine 
intAddress = (n - 1) * intHexWidth 
intHighAddress = 8 
intAddressArray(0) = intAddress 
For m = 1 To intHighAddress 
intAddressArray(m) = intAddressArray(m - 1) \ 16 
Next m 
For m = 1 To intHighAddress 
intAddressArray(m - 1) = intAddressArray(m - 1) - intAddressArray(m) * 16 
Next m 
For m = 1 To intHighAddress 
If intAddressArray(intHighAddress - m) < 10 Then 
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("0") 
Else 
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("A") - 10 
End If 
strAddress = strAddress + Chr$(intAddressArray(intHighAddress - m)) 
Next m 
strAddress = strAddress + Chr$(13) + Chr$(10) 
Next n 
txtAdd = strAddress '地址 
End Sub 
Private Sub cmdReceive_Click() 
If blnReceiveFlag Then 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
Me.cmdReceive.Caption = "开始接收" 
Else 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.MSComm.InputLen = 0 
Me.MSComm.InputMode = 0 
Me.MSComm.InBufferCount = 0 
Me.MSComm.RThreshold = 1 
Me.cmdReceive.Caption = "停止接收" 
End If 
blnReceiveFlag = Not blnReceiveFlag 
End Sub 

Private Sub Form_Load() 
intHexWidth = 8 
txtAdd = "" 
txtHex = "" 
txtAsc = "" 
txtSend = "11" 
txtAdd.Width = 1335 
txtHex.Width = 2535 
txtAsc.Width = 1215 
'设置默认发送接收关闭状态 
blnAutoSendFlag = False 
blnReceiveFlag = False 
'接收初始化 
intReceiveLen = 0 
'默认发送方式为16进制 
'intOutMode = 1 
'初始化串行口 
intPort = 1 
intTime = 1000 
strSet = "9600,n,8,1" 
Me.MSComm.InBufferSize = 1024 
Me.MSComm.OutBufferSize = 512 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.MSComm.PortOpen = False 
End Sub 

Private Sub cmdClear_Click() 
Dim bytTemp(0) As Byte 
ReDim bytReceiveByte(0) 
intReceiveLen = 0 
Call InputManage(bytTemp, 0) 
Call GetDisplayText 
Call disPlay 
End Sub 

Private Sub MsComm_OnComm() 
Dim bytInput() As Byte 
Dim intInputLen As Integer 
Select Case Me.MSComm.CommEvent 
Case comEvReceive 
If blnReceiveFlag Then 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
'此处添加处理接收的代码 
Me.MSComm.InputMode = comInputModeBinary '二进制接收 
intInputLen = Me.MSComm.InBufferCount 
ReDim bytInput(intInputLen) 
bytInput = Me.MSComm.Input 
Call InputManage(bytInput, intInputLen) 
Call GetDisplayText 
'Call disPlay 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
End If 
End Select 
End Sub 

Private Sub disPlay() 
txtHex = "" 
txtAsc = "" 
txtAdd = "" 
End Sub