通过VB向串口发送和接收十六进制指令？

YC3354 2017-12-01 05:17:24

有个需要通过串口传递数据的测量仪器！
通过串口测试软件测试发现，
若想要读取仪器测量值，必须先向设备发送8个字节的查询命令，形如“80 03 00 00 00 05 4B 1D ” ,
才会返回一串21字节的数据，形如 80 03 10 01 00 03 23 00 00 00 00 00 00 00 00 00 00 00 00 48 4B

取值过程如下：

现想通过VB利用mscomm组件实现数据读取，但不知道如何做。请大家帮个忙！！！

...全文

1694 4 打赏收藏转发到动态举报

写回复

用AI写文章

4 条回复

切换为时间正序

请发表友善的回复…

发表回复

YC3354 2017-12-04

打赏
举报

我需要用Mscomm控件的！

引用 1 楼 bakw 的回复:



Private Const DEFAULT_QUEUE = 1024

Private Const DEFAULT_WAIT_TIME = 50



Private Const GENERIC_READ = &H80000000

Private Const GENERIC_WRITE = &H40000000

Private Const OPEN_EXISTING = 3              '

Private Const PURGE_RXABORT = &H2

Private Const PURGE_RXCLEAR = &H8



'Utils

Private Const SYNCHRONIZE = &H100000

Private Const STANDARD_RIGHTS_READ = &H20000

Private Const ERROR_SUCCESS = 0&

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Const KEY_ENUMERATE_SUB_KEYS = &H8

Private Const KEY_NOTIFY = &H10

Private Const KEY_QUERY_VALUE = &H1

Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Private Const REG_DWORD = 4



'COM

Private Type COMMTIMEOUTS

        ReadIntervalTimeout As Long

        WriteTotalTimeoutConstant As Long

        ReadTotalTimeoutConstant As Long

        WriteTotalTimeoutMultiplier As Long

        ReadTotalTimeoutMultiplier As Long

End Type



Private Type COMSTAT

        fBitFields As Long

        cbInQue As Long

        cbOutQue As Long

End Type



Private Type DCB

    DCBlength As Long

    Baudrate As Long

    fBitFields As Long 'See Comments in Win32API.Txt

    wReserved As Integer

    XonLim As Integer

    XoffLim As Integer

    ByteSize As Byte

    Parity As Byte

    StopBits As Byte

    XOnChar As Byte

    XOffChar As Byte

    ErrorChar As Byte

    EofChar As Byte

    EvtChar As Byte

    wReserved1 As Integer 'Reserved; Do Not Use

End Type



Private Type OVERLAPPED

    ternal As Long

    hEvent As Long

    offset As Long

    OffsetHigh As Long

    ternalHigh As Long

End Type



Private Type SECURITY_ATTRIBUTES

        nLength As Long

        bInheritHandle As Long

        lpSecurityDescriptor As Long

End Type



'Common

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'COM

Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long

Private Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long

Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long

Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long

Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long

Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long

'Utils

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long



'Utils

Public Function EnumSerialPorts() As String  '枚举已存在的串口

    Dim hKey As Long, ID As Long, Result As String

    Dim Value As String, ValueLength As Long, Data As String, DataLength As Long

    Result = ""

    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", 0&, KEY_READ, hKey) = ERROR_SUCCESS Then

        Do

            ValueLength = 2000

            DataLength = 2000

            Value = String(ValueLength, Chr(32))  '注册项

            Data = String(DataLength, Chr(32)) '值 Com 名称

            If RegEnumValue(hKey, ID, ByVal Value, ValueLength, 0&, REG_DWORD, ByVal Data, DataLength) = ERROR_SUCCESS Then

                Result = Result & IIf(Len(Result) = 0, "", ",") & Trim(Replace(Left(Data, DataLength), Chr(0), Chr(32)))

            Else

                Exit Do

            End If

            ID = ID + 1

        Loop

        RegCloseKey hKey

    End If

    EnumSerialPorts = Result

End Function



Public Function ArrToHex(ByRef Arr() As Byte) As String

    Dim I As Integer, Result As String

    For I = 0 To UBound(Arr)

        Result = Result & Right("0" & Hex(Arr(I)), 2)

    Next

    ArrToHex = Result

End Function



Public Function HexToArr(ByVal Data As String) As Byte()

    Dim C As Integer, I As Integer, Arr() As Byte, CH As String

    On Error GoTo hErr

    C = Len(Data) \ 2 - 1

    ReDim Arr(C)

    For I = 0 To C

        CH = Mid(Data, I * 2 + 1, 2)

        Arr(I) = CByte("&H" & CH)

    Next

    HexToArr = Arr

hErr:

End Function



'COM

Public Sub ComClose(ByRef Handle As Long)

    If Handle = -1 Then Exit Sub

    CloseHandle Handle

    Handle = -1

End Sub



Public Function ComOpen(ByVal Port As String, Optional ByVal Settings As String = "9600,n,8,1", Optional ByVal dwInQueue As Long = DEFAULT_QUEUE, Optional ByVal dwOutQueue As Long = DEFAULT_QUEUE) As Long

    Dim Result As Long, lpDCB As DCB, lpCommTimeouts As COMMTIMEOUTS, lpSA As SECURITY_ATTRIBUTES

    ComOpen = -1

    If IsNumeric(Port) Then

        Port = "\\.\Com" & Port

    Else

        Port = "\\.\" & Port

    End If

    Result = CreateFile(Port, GENERIC_READ Or GENERIC_WRITE, 0&, lpSA, OPEN_EXISTING, 0, 0&)

    If Result = -1 Then Exit Function

    If GetCommState(Result, lpDCB) = 0 Then

        CloseHandle Result

        Exit Function

    End If

    BuildCommDCB Settings, lpDCB

    If SetCommState(Result, lpDCB) = 0 Then

        CloseHandle Result

        Exit Function

    End If

    SetupComm Result, dwInQueue, dwOutQueue  '分配串口缓冲区

    '设定通讯超时参数

    lpCommTimeouts.ReadIntervalTimeout = 2

    lpCommTimeouts.ReadTotalTimeoutConstant = 4

    lpCommTimeouts.ReadTotalTimeoutMultiplier = 3

    lpCommTimeouts.WriteTotalTimeoutConstant = 5000 '一次写入串口数据的固定超时。

    lpCommTimeouts.WriteTotalTimeoutMultiplier = 50 '写入每字符间的超时。

    SetCommTimeouts Result, lpCommTimeouts

    ComOpen = Result

End Function



Public Function ComReadByte(ByVal Handle As Long, ByRef Result() As Byte, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As Long

    Dim lpOverlapped As OVERLAPPED, lpStat As COMSTAT, lpErrors As Long

    If Handle = -1 Then Exit Function

    ComReadByte = 0

    If WaitTime > 0 Then Sleep WaitTime

    ClearCommError Handle, lpErrors, lpStat

    If lpStat.cbInQue > 0 Then

        ReDim Result(DEFAULT_QUEUE - 1) '设置缓冲区大小1K

        ReadFile Handle, Result(0), lpStat.cbInQue, ComReadByte, lpOverlapped

        If ComReadByte > 0 Then

            ReDim Preserve Result(ComReadByte - 1)

        Else

            Erase Result

        End If

    End If

End Function



Public Function ComWriteByte(ByVal Handle As Long, ByRef Data() As Byte) As Long

    Dim lpOverlapped As OVERLAPPED, lpErrors As Long, lpStat As COMSTAT

    If (Handle = -1) Or (Len(StrConv(Data, vbUnicode)) = 0) Then Exit Function

    PurgeComm Handle, PURGE_RXABORT Or PURGE_RXCLEAR  '清空输入缓冲区

    WriteFile Handle, Data(0), UBound(Data) + 1, ComWriteByte, lpOverlapped

    Do

        ClearCommError Handle, lpErrors, lpStat

    Loop Until lpStat.cbOutQue = 0  '等待输出结束

End Function



使用如下：

Dim hCom As Long,Data() As Byte

hCom=ComOpen("COM1","9600,n,8,1")

ComWriteByte hCom,HexToArr("8003000000054B1D")

ComReadByte hCom,Data

ComClose hCom'如果没有调用 ComClose hCom 而强制结束程序的话，你要重启VB程序才能工作

Debug.Print ArrToHex(Data)

zdingyun 2017-12-04

打赏
举报

引用楼主 YC3354 的回复:

有个需要通过串口传递数据的测量仪器！通过串口测试软件测试发现，若想要读取仪器测量值，必须先向设备发送8个字节的查询命令，形如“80 03 00 00 00 05 4B 1D ” , 才会返回一串21字节的数据，形如 80 03 10 01 00 03 23 00 00 00 00 00 00 00 00 00 00 00 00 48 4B 取值过程如下：现想通过VB利用mscomm组件实现数据读取，但不知道如何做。请大家帮个忙！！！

会不会打开答帖所附的链接呀，通过链接可下载和查看VB6.0用16进制字符转换为Byte字节流的串口的MsComm控件工程及代码。 http://www.vbgood.com/thread-83700-1-1.html

zdingyun 2017-12-02

打赏
举报

参考：串口调试软件

笨狗先飞 2017-12-02

打赏
举报


Private Const DEFAULT_QUEUE = 1024
Private Const DEFAULT_WAIT_TIME = 50

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3              '
Private Const PURGE_RXABORT = &H2
Private Const PURGE_RXCLEAR = &H8

'Utils
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const ERROR_SUCCESS = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_DWORD = 4

'COM
Private Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        WriteTotalTimeoutConstant As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        ReadTotalTimeoutMultiplier As Long
End Type

Private Type COMSTAT
        fBitFields As Long
        cbInQue As Long
        cbOutQue As Long
End Type

Private Type DCB
    DCBlength As Long
    Baudrate As Long
    fBitFields As Long 'See Comments in Win32API.Txt
    wReserved As Integer
    XonLim As Integer
    XoffLim As Integer
    ByteSize As Byte
    Parity As Byte
    StopBits As Byte
    XOnChar As Byte
    XOffChar As Byte
    ErrorChar As Byte
    EofChar As Byte
    EvtChar As Byte
    wReserved1 As Integer 'Reserved; Do Not Use
End Type

Private Type OVERLAPPED
    ternal As Long
    hEvent As Long
    offset As Long
    OffsetHigh As Long
    ternalHigh As Long
End Type

Private Type SECURITY_ATTRIBUTES
        nLength As Long
        bInheritHandle As Long
        lpSecurityDescriptor As Long
End Type

'Common
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'COM
Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Private Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
'Utils
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'Utils
Public Function EnumSerialPorts() As String  '枚举已存在的串口
    Dim hKey As Long, ID As Long, Result As String
    Dim Value As String, ValueLength As Long, Data As String, DataLength As Long
    Result = ""
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", 0&, KEY_READ, hKey) = ERROR_SUCCESS Then
        Do
            ValueLength = 2000
            DataLength = 2000
            Value = String(ValueLength, Chr(32))  '注册项
            Data = String(DataLength, Chr(32)) '值 Com 名称
            If RegEnumValue(hKey, ID, ByVal Value, ValueLength, 0&, REG_DWORD, ByVal Data, DataLength) = ERROR_SUCCESS Then
                Result = Result & IIf(Len(Result) = 0, "", ",") & Trim(Replace(Left(Data, DataLength), Chr(0), Chr(32)))
            Else
                Exit Do
            End If
            ID = ID + 1
        Loop
        RegCloseKey hKey
    End If
    EnumSerialPorts = Result
End Function

Public Function ArrToHex(ByRef Arr() As Byte) As String
    Dim I As Integer, Result As String
    For I = 0 To UBound(Arr)
        Result = Result & Right("0" & Hex(Arr(I)), 2)
    Next
    ArrToHex = Result
End Function

Public Function HexToArr(ByVal Data As String) As Byte()
    Dim C As Integer, I As Integer, Arr() As Byte, CH As String
    On Error GoTo hErr
    C = Len(Data) \ 2 - 1
    ReDim Arr(C)
    For I = 0 To C
        CH = Mid(Data, I * 2 + 1, 2)
        Arr(I) = CByte("&H" & CH)
    Next
    HexToArr = Arr
hErr:
End Function

'COM
Public Sub ComClose(ByRef Handle As Long)
    If Handle = -1 Then Exit Sub
    CloseHandle Handle
    Handle = -1
End Sub

Public Function ComOpen(ByVal Port As String, Optional ByVal Settings As String = "9600,n,8,1", Optional ByVal dwInQueue As Long = DEFAULT_QUEUE, Optional ByVal dwOutQueue As Long = DEFAULT_QUEUE) As Long
    Dim Result As Long, lpDCB As DCB, lpCommTimeouts As COMMTIMEOUTS, lpSA As SECURITY_ATTRIBUTES
    ComOpen = -1
    If IsNumeric(Port) Then
        Port = "\\.\Com" & Port
    Else
        Port = "\\.\" & Port
    End If
    Result = CreateFile(Port, GENERIC_READ Or GENERIC_WRITE, 0&, lpSA, OPEN_EXISTING, 0, 0&)
    If Result = -1 Then Exit Function
    If GetCommState(Result, lpDCB) = 0 Then
        CloseHandle Result
        Exit Function
    End If
    BuildCommDCB Settings, lpDCB
    If SetCommState(Result, lpDCB) = 0 Then
        CloseHandle Result
        Exit Function
    End If
    SetupComm Result, dwInQueue, dwOutQueue  '分配串口缓冲区
    '设定通讯超时参数
    lpCommTimeouts.ReadIntervalTimeout = 2
    lpCommTimeouts.ReadTotalTimeoutConstant = 4
    lpCommTimeouts.ReadTotalTimeoutMultiplier = 3
    lpCommTimeouts.WriteTotalTimeoutConstant = 5000 '一次写入串口数据的固定超时。
    lpCommTimeouts.WriteTotalTimeoutMultiplier = 50 '写入每字符间的超时。
    SetCommTimeouts Result, lpCommTimeouts
    ComOpen = Result
End Function

Public Function ComReadByte(ByVal Handle As Long, ByRef Result() As Byte, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As Long
    Dim lpOverlapped As OVERLAPPED, lpStat As COMSTAT, lpErrors As Long
    If Handle = -1 Then Exit Function
    ComReadByte = 0
    If WaitTime > 0 Then Sleep WaitTime
    ClearCommError Handle, lpErrors, lpStat
    If lpStat.cbInQue > 0 Then
        ReDim Result(DEFAULT_QUEUE - 1) '设置缓冲区大小1K
        ReadFile Handle, Result(0), lpStat.cbInQue, ComReadByte, lpOverlapped
        If ComReadByte > 0 Then
            ReDim Preserve Result(ComReadByte - 1)
        Else
            Erase Result
        End If
    End If
End Function

Public Function ComWriteByte(ByVal Handle As Long, ByRef Data() As Byte) As Long
    Dim lpOverlapped As OVERLAPPED, lpErrors As Long, lpStat As COMSTAT
    If (Handle = -1) Or (Len(StrConv(Data, vbUnicode)) = 0) Then Exit Function
    PurgeComm Handle, PURGE_RXABORT Or PURGE_RXCLEAR  '清空输入缓冲区
    WriteFile Handle, Data(0), UBound(Data) + 1, ComWriteByte, lpOverlapped
    Do
        ClearCommError Handle, lpErrors, lpStat
    Loop Until lpStat.cbOutQue = 0  '等待输出结束
End Function

使用如下：
Dim hCom As Long,Data() As Byte
hCom=ComOpen("COM1","9600,n,8,1")
ComWriteByte hCom,HexToArr("8003000000054B1D")
ComReadByte hCom,Data
ComClose hCom'如果没有调用 ComClose hCom 而强制结束程序的话，你要重启VB程序才能工作
Debug.Print ArrToHex(Data)