用VB编写串口调试工具

是用VB调试精灵的源代码改过来的，以16进制方式显示发送：

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 MeMSCommPortOpen Then

MeMSCommCommPort = intPort

MeMSCommSettings = strSet

MeMSCommPortOpen = True

End If

Call ctrTimer_Timer

If Not blnAutoSendFlag Then

MeMSCommPortOpen = False

End If

End Sub

Private Sub cmdAutoSend_Click()

If blnAutoSendFlag Then

MectrTimerEnabled = False

If Not blnReceiveFlag Then

MeMSCommPortOpen = False

End If

MecmdAutoSendCaption = "自动发送"

Else

If Not MeMSCommPortOpen Then

MeMSCommCommPort = intPort

MeMSCommSettings = strSet

MeMSCommPortOpen = True

End If

MectrTimerInterval = intTime

MectrTimerEnabled = True

MecmdAutoSendCaption = "停止发送"

End If

blnAutoSendFlag = Not blnAutoSendFlag

End Sub

Private Sub ctrTimer_Timer()

Dim longth As Integer

strSendText = MetxtSendText

longth = strHexToByteArray(strSendText, bytSendByte())

If longth > 0 Then

MeMSCommOutput = 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

MeMSCommPortOpen = False

End If

MecmdReceiveCaption = "开始接收"

Else

If Not MeMSCommPortOpen Then

MeMSCommCommPort = intPort

MeMSCommSettings = strSet

MeMSCommPortOpen = True

End If

MeMSCommInputLen = 0

MeMSCommInputMode = 0

MeMSCommInBufferCount = 0

MeMSCommRThreshold = 1

MecmdReceiveCaption = "停止接收"

End If

blnReceiveFlag = Not blnReceiveFlag

End Sub

Private Sub Form_Load()

intHexWidth = 8

txtAdd = ""

txtHex = ""

txtAsc = ""

txtSend = "11"

txtAddWidth = 1335

txtHexWidth = 2535

txtAscWidth = 1215

'设置默认发送接收关闭状态

blnAutoSendFlag = False

blnReceiveFlag = False

'接收初始化

intReceiveLen = 0

'默认发送方式为16进制

'intOutMode = 1

'初始化串行口

intPort = 1

intTime = 1000

strSet = "9600,n,8,1"

MeMSCommInBufferSize = 1024

MeMSCommOutBufferSize = 512

If Not MeMSCommPortOpen Then

MeMSCommCommPort = intPort

MeMSCommSettings = strSet

MeMSCommPortOpen = True

End If

MeMSCommPortOpen = 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 MeMSCommCommEvent

Case comEvReceive

If blnReceiveFlag Then

If Not MeMSCommPortOpen Then

MeMSCommCommPort = intPort

MeMSCommSettings = strSet

MeMSCommPortOpen = True

End If

'此处添加处理接收的代码

MeMSCommInputMode = comInputModeBinary '二进制接收

intInputLen = MeMSCommInBufferCount

ReDim bytInput(intInputLen)

bytInput = MeMSCommInput

Call InputManage(bytInput, intInputLen)

Call GetDisplayText

'Call disPlay

If Not blnReceiveFlag Then

MeMSCommPortOpen = False

End If

End If

End Select

End Sub

Private Sub disPlay()

txtHex = ""

txtAsc = ""

txtAdd = ""

End Sub

再VB中部件里面找到 Microsoft Comm Control 60，然后工具箱里面会出现一个电话图标，画到工程里面就行了，和时间控件很像

剩下的自己去网上找串口通讯的资料吧，最简单最多的是和单片机用RS232串口连接的，百度文库里面就有很多！

一个server端

Private Sub Command1_Click()

End

End Sub

Private Sub Command2_Click()

WinsockserverSendData Text4Text + ":" + textsendText

textgetText = textgetText + vbCrLf + Text4Text + ":" + textsendText + " " + Str(Time)

textsendText = ""

End Sub

Private Sub Form_Load()

Command2Visible = False

textsendVisible = False

Text4Visible = False

textgetVisible = False

Label1Visible = False

WinsockserverLocalPort = 1001

WinsockserverListen

End Sub

Private Sub textsend_Change()

'WinsockserverSendData textsendtext

End Sub

Private Sub textsend_KeyPress(KeyAscii As Integer)

'If KeyAscii = 13 Then

'WinsockserverSendData textsendtext

'textsendtext = ""

If KeyAscii = 13 Then

WinsockserverSendData textsendText

' Text1text = Text1text + vbCrLf + Text4text + ": " + Text2text + " " + Str(Time)

textsendText = ""

End If

End Sub

Private Sub Timer1_Timer()

If Text4Text = "" Then Text4Text = "no name"

End Sub

Private Sub Winsockserver_Close()

WinsockserverClose

End

End Sub

Private Sub Winsockserver_ConnectionRequest(ByVal requestID As Long)

Command2Visible = True

textsendVisible = True

textgetVisible = True

Text4Visible = True

Label1Visible = True

If WinsockserverState <> sckClosed Then WinsockserverClose

WinsockserverAccept requestID

End Sub

Private Sub Winsockserver_DataArrival(ByVal bytesTotal As Long)

Dim tmpstr As String

WinsockserverGetData tmpstr

'textgettext = textget + tmpstr + textsend

textgetText = textgetText + vbCrLf + tmpstr + " " + Str(Time)

End Sub

'（1）Command1：退出按钮；

'（2）textsend：发送数据文本框；

'（3）Winsockserver： 服务器Winsock；

'（4）textget ：接收数据文本框。

一个clien

以上就是关于用VB编写串口调试工具全部的内容，包括:用VB编写串口调试工具、vb新手请教，想做一个串口通讯程序、VB实现串口通讯程序代码等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！