我正在尝试将Excel与某些比例集成。秤使用串行端口进行通信。我可以读得很好,但我需要发送规模的命令。这是读取和写入功能。
'-------------------------------------------------------------------------------
' CommRead - Read serial port input buffer.
'
' Parameters:
' intPortID - Port ID used when port was opened.
' strData - Data buffer.
' lngSize - Maximum number of bytes to be read.
'
' Returns:
' Error Code - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommRead(intPortID As Integer, strData As String, _
lngSize As Long) As Long
Dim lngStatus As Long
Dim lngRdSize As Long, lngBytesRead As Long
Dim lngRdStatus As Long, strRdBuffer As String * 1024
Dim lngErrorFlags As Long, udtCommStat As COMSTAT
On Error GoTo Routine_Error
strData = ""
lngBytesRead = 0
DoEvents
' Clear any previous errors and get current status.
lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
udtCommStat)
If lngStatus = 0 Then
lngBytesRead = -1
lngStatus = SetCommError("CommRead (ClearCommError)")
GoTo Routine_Exit
End If
'---------------------------------------------------------------------------------
' If udtCommStat.cbInQue > 0 Then
' If udtCommStat.cbInQue > lngSize Then
' lngRdSize = udtCommStat.cbInQue
' Else
' lngRdSize = lngSize
' End If
' Else
' lngRdSize = 0
' End If
'------------------------------------------------------------------------------------
lngRdSize = lngSize
If lngRdSize Then
lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
lngRdSize, lngBytesRead, udtCommOverlap)
If lngRdStatus = 0 Then
lngStatus = GetLastError
If lngStatus = ERROR_IO_PENDING Then
' Wait for read to complete.
' This function will timeout according to the
' COMMTIMEOUTS.ReadTotalTimeoutConstant variable.
' Every time it times out, check for port errors.
' Loop until operation is complete.
While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
udtCommOverlap, lngBytesRead, True) = 0
lngStatus = GetLastError
If lngStatus <> ERROR_IO_INCOMPLETE Then
lngBytesRead = -1
lngStatus = SetCommErrorEx( _
"CommRead (GetOverlappedResult)", _
udtPorts(intPortID).lngHandle)
GoTo Routine_Exit
End If
Wend
Else
' Some other error occurred.
lngBytesRead = -1
lngStatus = SetCommErrorEx("CommRead (ReadFile)", _
udtPorts(intPortID).lngHandle)
GoTo Routine_Exit
End If
End If
strData = Left$(strRdBuffer, lngBytesRead)
End If
Routine_Exit:
CommRead = lngBytesRead
Exit Function
Routine_Error:
lngBytesRead = -1
lngStatus = Err.Number
With udtCommError
.lngErrorCode = lngStatus
.strFunction = "CommRead"
.strErrorMessage = Err.Description
End With
Resume Routine_Exit
End Function
'-------------------------------------------------------------------------------
' CommWrite - Output data to the serial port.
'
' Parameters:
' intPortID - Port ID used when port was opened.
' strData - Data to be transmitted.
'
' Returns:
' Error Code - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommWrite(intPortID As Integer, strData As String) As Long
Dim i As Integer
Dim lngStatus As Long, lngSize As Long
Dim lngWrSize As Long, lngWrStatus As Long
On Error GoTo Routine_Error
' Get the length of the data.
lngSize = Len(strData)
' Output the data.
lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _
lngWrSize, udtCommOverlap)
' Note that normally the following code will not execute because the driver
' caches write operations. Small I/O requests (up to several thousand bytes)
' will normally be accepted immediately and WriteFile will return true even
' though an overlapped operation was specified.
DoEvents
If lngWrStatus = 0 Then
lngStatus = GetLastError
If lngStatus = 0 Then
GoTo Routine_Exit
ElseIf lngStatus = ERROR_IO_PENDING Then
' We should wait for the completion of the write operation so we know
' if it worked or not.
'
' This is only one way to do this. It might be beneficial to place the
' writing operation in a separate thread so that blocking on completion
' will not negatively affect the responsiveness of the UI.
'
' If the write takes long enough to complete, this function will
' timeout
' according to the CommTimeOuts.WriteTotalTimeoutConstant variable.
' At that time we can check for errors and then wait some more.
' Loop until operation is complete.
While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
udtCommOverlap, lngWrSize, True) = 0
lngStatus = GetLastError
If lngStatus <> ERROR_IO_INCOMPLETE Then
lngStatus = SetCommErrorEx( _
"CommWrite (GetOverlappedResult)", _
udtPorts(intPortID).lngHandle)
GoTo Routine_Exit
End If
Wend
Else
' Some other error occurred.
lngWrSize = -1
lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _
udtPorts(intPortID).lngHandle)
GoTo Routine_Exit
End If
End If
For i = 1 To 10
DoEvents
Next
Routine_Exit:
CommWrite = lngWrSize
Exit Function
Routine_Error:
lngStatus = Err.Number
With udtCommError
.lngErrorCode = lngStatus
.strFunction = "CommWrite"
.strErrorMessage = Err.Description
End With
Resume Routine_Exit
End Function
这可能只是我尝试将字符串输入为Ascii的方式。以下是给出命令手册中的说明:
发送到天平的命令包含ASCII字符集的一个或多个字符。在这里,必须注意以下几点: 仅以大写形式输入命令。然而,单位必须适当地资本化。 命令的可能参数必须彼此分开,并且与命令名称分开 空格(ASCII 32 dec。,在本手册中表示为)。 “text”的可能输入是从32 dec开始的8位ASCII字符集的字符序列。到255分。 每个命令必须由CR LF关闭(ASCII 13 dec。,10 dec。)。
如果我想发送“Z”命令,我会以这种格式发送901310吗?
Private Sub GetWeight1_Click()
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim lngWrStatus As Long
Dim strData As String
Dim lngSize As Long
intPortID = 4
strData = "901310"
lngWrStatus = CommWrite(intPortID, strData)
'lngStatus = CommRead(intPortID, strData, 12)
也许代码很好但字符串不是。我没有编写这段代码但读取功能运行良好。我只是无法让write函数运行。任何帮助都会很棒!谢谢!
答案 0 :(得分:0)
根据您提供的设备的说明以及我对发布的代码的作用的理解,似乎需要编写必要的信息才能发送&#34; Z&#34;命令将是&#34; Z&#34;然后是CR / LF组合,即使用
strData = "Z" & vbCrLF
或(如果你想避免内置常量)
strData = "Z" & Chr(13) & Chr(10)