Question

所以我的问题是我正在使用一块硬件，并且在一台计算机上它可以正常工作我的鳕鱼工作正常。

另一方面，它不起作用。我不是一个真正的编码器，所以我认为我做的事情很糟糕，导致软件不稳定。这是我的代码

这是我认为导致问题的功能。

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


Function writetoBM5A(data As String, Bm5ACom As Long)
Dim lengthofstring As Integer
Dim i As Integer

lengthofstring = Len(data)
For i = 1 To lengthofstring
    WriteCom Bm5ACom, Mid(Trim(data), i, 1)
    Sleep 100 ' I have tried changing the sleep duration but doesn't help. I do get different random characters based on the sleep duration
Next
WriteCom Bm5ACom, Chr(13)

End Function

当上述功能正常工作时，我在readcom时会收到“OK”。当它不是我得到一些随机的ASCII字符。

以下是我的主要子程序

Private Sub CommandButton1_Click()
Dim flag As Boolean


If CommandButton1.Caption = "Start" Then
    CommandButton1.Caption = "Stop"
    flag = True
    Dim Bm5ACom As Long
    Bm5ACom = OpenCom(5, 9600&)
    writetoBM5A "RM", Bm5ACom 'Puts hardware into Remote Mode
    Sleep 3000
    writetoBM5A "ST", Bm5ACom 'Takes a test measurement
    Sleep 3000
    ClearCom Bm5ACom
    CloseCom Bm5ACom
    Sleep 3000
Else
    CommandButton1.Caption = "Start"
    flag = False
End If

While CommandButton1.Caption = "Stop"
    Sleep 1000
    DoEvents
    Range("C1").Value = Range("C1").Value - 1
    If Range("C1").Value = 1 Then
        Range("C1").Value = 300
        takeameasurement
    End If
Wend

MsgBox "I exited the while loop!"
writetoBM5A "LM", Bm5ACom 'puts BM5A into Local mode
Exit Sub
End Sub

作为参考，这些是通信命令，我没有编写这些通信协议，只是理解它们。

Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long

OpenCom命令

Function OpenCom(PortNum As Integer, Baud As Long) As Long

Dim lpDCB As DCB
Dim ComTimeout As COMMTIMEOUTS

COM$ = "COM" + Trim(Str(PortNum))

'open the communications port
hComTemp& = CreateFile(COM$, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, ByVal 0)

'check for errors
If hComTemp& < 0 Then
    OpenCom = hComTemp&
    Exit Function
End If

'create the control string
build$ = "baud=" + Trim(Str(Baud)) + " parity=Odd data=7 stop=1"

'build the data communications block
r& = BuildCommDCB(build$, lpDCB)

'set the communications port's parameters with the DCB
r& = SetCommState(hComTemp&, lpDCB)

ComTimeout.ReadIntervalTimeout = 100       'maximum time to wait between received bytes (milliseconds)
ComTimeout.ReadTotalTimeoutConstant = 1000  'maximum time to wait for receive data (milliseconds)

'set the timeouts
r& = SetCommTimeouts(hComTemp&, ComTimeout)

'set the input buffer size to 4096 bytes and the output buffer size to 4096 bytes
r& = SetupComm(hComTemp&, 4096, 4096)

'return the handle of the newly opened communications port
OpenCom = hComTemp&

End Function

write com命令。

Sub WriteCom(hcom As Long, WriteString$)

r& = WriteFile(hcom, ByVal WriteString$, Len(WriteString$), lpNumberOfBytesWritten&, ByVal 0)
End Sub

read com命令。

Function readcom(hcom As Long, NumberOfBytes As Long) As String

Buffer$ = String(NumberOfBytes + 1, 0)

r& = ReadFile(hcom, ByVal Buffer$, NumberOfBytes, lpNumberOfBytesRead&, ByVal 0)

If lpNumberOfBytesRead& > 0 Then
    readcom = Left$(Buffer$, lpNumberOfBytesRead&)
Else
    readcom = ""
End If

End Function

clear com命令

Sub ClearCom(hcom As Long)

'clear the comm port and set the input buffer size to 4096 bytes and the output buffer size to 4096 bytes
'r& = SetupComm(hCom, 4096, 4096)

r& = PurgeComm(hcom, &HF&)

End Sub

关闭com命令

Sub CloseCom(hcom As Long)

r& = CloseHandle(hcom)

End Sub

VBA COM端口通信（发送和接收ASCII文本）

0 个答案: