I'm trying to figure out how to send a string of data to a com port.
The receiving end of my string will be a machine that directs what it gets from me to certain machines.
I will build the string using data from the user. I don't know if I should build a table first and then send the one line of the table to the port or try and build a string to send.
The string will consist of 8 byte fields byte0 is a constant number of 400 while byte 1 - 7 will be data from the user.
I started by building a table and then just updating the table with the data needed. However I don't know if I can send the single line of data from the table to the com port.
I'm really looking for any advise on a good way to do this.
Thanks for all your help in the past and looking forward to your good insight.
11 9107 NeoPa 32,556
Expert Mod 16PB
As a general rule you won't have direct access to any of the system's ports Tom. Do you have some sort of API in mind that allows you to interface with the RS232 port?
Like I mentioned this is my first time trying something like this so any advice would be greatly appreciated.
I did find some code on the internet that I'm trying to figure out I've listed it here there is a .bas and some sample code - Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
-
Dim lngStatus As Long
-
Dim strError As String
-
Dim strData As String
-
-
-
' Initialize Communications
-
lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
-
"baud=9600 parity=N data=8 stop=1")
-
-
If lngStatus <> 0 Then
-
' Handle error.
-
lngStatus = CommGetError(strError)
-
MsgBox "COM Error: " & strError
-
End If
-
-
-
' Set modem control lines.
-
lngStatus = CommSetLine(intPortID, LINE_RTS, True)
-
lngStatus = CommSetLine(intPortID, LINE_DTR, True)
-
-
' Write data to serial port.
-
lngSize = Len(strData)
-
lngStatus = CommWrite(intPortID, strData)
-
If lngStatus <> lngSize Then
-
' Handle error.
-
End If
-
-
-
-
' Read maximum of 64 bytes from serial port.
-
lngStatus = CommRead(intPortID, strData, 64)
-
If lngStatus > 0 Then
-
' Process data.
-
ElseIf lngStatus < 0 Then
-
' Handle error.
-
End If
-
-
' Reset modem control lines.
-
lngStatus = CommSetLine(intPortID, LINE_RTS, False)
-
lngStatus = CommSetLine(intPortID, LINE_DTR, False)
-
-
-
-
' Close communications.
-
Call CommClose(intPortID)
-
the .bas is quite large if you want me to add it let me know.
Thanks for the reply and any help
NeoPa 32,556
Expert Mod 16PB
It looks like you have a workable approach available Tom. Unfortunately, you need someone with the understanding of that particular API to help you.
I assume you know that this code will actually be allowed to run? As I said earlier, standard code not have direct access to the hardware. On the other hand, it may well be that the API you're using goes from a position of trust (IE. from the correct side of the HAL - Hardware Abstraction Layer - of the OS).
I could help on the VBA side, but it looks like that isn't what you need here.
zmbd 5,501
Expert Mod 4TB
CDTOM:
The code you have posted is dependent on what looks to be either a class module or some supporting functions - win32api?
You might also be able to just open the COM port using the OPEN function like you would for a printer or text file. VBA Standard Text File I/O Statements
-- just use "COM#:"
So something like:
((((WARNING AIR CODE)))) -
Dim zOpenPort as Integer
-
Dim zrecord as string * 8 '8bytes?
-
'
-
zopenport = freefile
-
'open com1 at 2400B 8bit no parity 1 stop bit
-
'you will need to change the com-port to match where
-
'you've connected.
-
Open "COM1:2400,N,8,1" for random as zopenport
-
'
-
'Ok from here... I'm skechy... we can use write, get, etc...
-
'to push/pull the data. Just depends on things...
-
'
-
Then there's the MSCOMM control in Visual Basic... haven't checked to see if it's available in MSAccessVBA
I do have a class module see code. - Option Compare Database
-
-
'Attribute VB_Name = "modCOMM"
-
Option Explicit
-
-
'-------------------------------------------------------------------------------
-
' modCOMM - Written by: David M. Hitchner
-
'
-
' This VB module is a collection of routines to perform serial port I/O without
-
' using the Microsoft Comm Control component. This module uses the Windows API
-
' to perform the overlapped I/O operations necessary for serial communications.
-
'
-
' The routine can handle up to 4 serial ports which are identified with a
-
' Port ID.
-
'
-
' All routines (with the exception of CommRead and CommWrite) return an error
-
' code or 0 if no error occurs. The routine CommGetError can be used to get
-
' the complete error message.
-
'-------------------------------------------------------------------------------
-
-
'-------------------------------------------------------------------------------
-
' Public Constants
-
'-------------------------------------------------------------------------------
-
-
' Output Control Lines (CommSetLine)
-
Public Const LINE_BREAK = 1
-
Public Const LINE_DTR = 2
-
Public Const LINE_RTS = 3
-
-
' Input Control Lines (CommGetLine)
-
Public Const LINE_CTS = &H10&
-
Public Const LINE_DSR = &H20&
-
Public Const LINE_RING = &H40&
-
Public Const LINE_RLSD = &H80&
-
Public Const LINE_CD = &H80&
-
-
'-------------------------------------------------------------------------------
-
' System Constants
-
'-------------------------------------------------------------------------------
-
Private Const ERROR_IO_INCOMPLETE = 996&
-
Private Const ERROR_IO_PENDING = 997
-
Private Const GENERIC_READ = &H80000000
-
Private Const GENERIC_WRITE = &H40000000
-
Private Const FILE_ATTRIBUTE_NORMAL = &H80
-
Private Const FILE_FLAG_OVERLAPPED = &H40000000
-
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
-
Private Const OPEN_EXISTING = 3
-
-
' COMM Functions
-
Private Const MS_CTS_ON = &H10&
-
Private Const MS_DSR_ON = &H20&
-
Private Const MS_RING_ON = &H40&
-
Private Const MS_RLSD_ON = &H80&
-
Private Const PURGE_RXABORT = &H2
-
Private Const PURGE_RXCLEAR = &H8
-
Private Const PURGE_TXABORT = &H1
-
Private Const PURGE_TXCLEAR = &H4
-
-
' COMM Escape Functions
-
Private Const CLRBREAK = 9
-
Private Const CLRDTR = 6
-
Private Const CLRRTS = 4
-
Private Const SETBREAK = 8
-
Private Const SETDTR = 5
-
Private Const SETRTS = 3
-
-
'-------------------------------------------------------------------------------
-
' System Structures
-
'-------------------------------------------------------------------------------
-
Private Type COMSTAT
-
fBitFields As Long ' See Comment in Win32API.Txt
-
cbInQue As Long
-
cbOutQue As Long
-
End Type
-
-
Private Type COMMTIMEOUTS
-
ReadIntervalTimeout As Long
-
ReadTotalTimeoutMultiplier As Long
-
ReadTotalTimeoutConstant As Long
-
WriteTotalTimeoutMultiplier As Long
-
WriteTotalTimeoutConstant As Long
-
End Type
-
-
'
-
' The DCB structure defines the control setting for a serial
-
' communications device.
-
'
-
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
-
Internal As Long
-
InternalHigh As Long
-
offset As Long
-
OffsetHigh As Long
-
hEvent As Long
-
End Type
-
-
Private Type SECURITY_ATTRIBUTES
-
nLength As Long
-
lpSecurityDescriptor As Long
-
bInheritHandle As Long
-
End Type
-
-
'-------------------------------------------------------------------------------
-
' System Functions
-
'-------------------------------------------------------------------------------
-
'
-
' Fills a specified DCB structure with values specified in
-
' a device-control string.
-
'
-
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" _
-
(ByVal lpDef As String, lpDCB As DCB) As Long
-
'
-
' Retrieves information about a communications error and reports
-
' the current status of a communications device. The function is
-
' called when a communications error occurs, and it clears the
-
' device's error flag to enable additional input and output
-
' (I/O) operations.
-
'
-
Declare Function ClearCommError Lib "kernel32" _
-
(ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
-
'
-
' Closes an open communications device or file handle.
-
'
-
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
-
'
-
' Creates or opens a communications resource and returns a handle
-
' that can be used to access the resource.
-
'
-
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
-
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
-
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
-
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
-
ByVal hTemplateFile As Long) As Long
-
'
-
' Directs a specified communications device to perform a function.
-
'
-
Declare Function EscapeCommFunction Lib "kernel32" _
-
(ByVal nCid As Long, ByVal nFunc As Long) As Long
-
'
-
' Formats a message string such as an error string returned
-
' by anoher function.
-
'
-
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
-
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
-
ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
-
Arguments As Long) As Long
-
'
-
' Retrieves modem control-register values.
-
'
-
Declare Function GetCommModemStatus Lib "kernel32" _
-
(ByVal hFile As Long, lpModemStat As Long) As Long
-
'
-
' Retrieves the current control settings for a specified
-
' communications device.
-
'
-
Declare Function GetCommState Lib "kernel32" _
-
(ByVal nCid As Long, lpDCB As DCB) As Long
-
'
-
' Retrieves the calling thread's last-error code value.
-
'
-
Declare Function GetLastError Lib "kernel32" () As Long
-
'
-
' Retrieves the results of an overlapped operation on the
-
' specified file, named pipe, or communications device.
-
'
-
Declare Function GetOverlappedResult Lib "kernel32" _
-
(ByVal hFile As Long, lpOverlapped As OVERLAPPED, _
-
lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long
-
'
-
' Discards all characters from the output or input buffer of a
-
' specified communications resource. It can also terminate
-
' pending read or write operations on the resource.
-
'
-
Declare Function PurgeComm Lib "kernel32" _
-
(ByVal hFile As Long, ByVal dwFlags As Long) As Long
-
'
-
' Reads data from a file, starting at the position indicated by the
-
' file pointer. After the read operation has been completed, the
-
' file pointer is adjusted by the number of bytes actually read,
-
' unless the file handle is created with the overlapped attribute.
-
' If the file handle is created for overlapped input and output
-
' (I/O), the application must adjust the position of the file pointer
-
' after the read operation.
-
'
-
Declare Function ReadFile Lib "kernel32" _
-
(ByVal hFile As Long, ByVal lpBuffer As String, _
-
ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, _
-
lpOverlapped As OVERLAPPED) As Long
-
'
-
' Configures a communications device according to the specifications
-
' in a device-control block (a DCB structure). The function
-
' reinitializes all hardware and control settings, but it does not
-
' empty output or input queues.
-
'
-
Declare Function SetCommState Lib "kernel32" _
-
(ByVal hCommDev As Long, lpDCB As DCB) As Long
-
'
-
' Sets the time-out parameters for all read and write operations on a
-
' specified communications device.
-
'
-
Declare Function SetCommTimeouts Lib "kernel32" _
-
(ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
-
'
-
' Initializes the communications parameters for a specified
-
' communications device.
-
'
-
Declare Function SetupComm Lib "kernel32" _
-
(ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
-
'
-
' Writes data to a file and is designed for both synchronous and a
-
' synchronous operation. The function starts writing data to the file
-
' at the position indicated by the file pointer. After the write
-
' operation has been completed, the file pointer is adjusted by the
-
' number of bytes actually written, except when the file is opened with
-
' FILE_FLAG_OVERLAPPED. If the file handle was created for overlapped
-
' input and output (I/O), the application must adjust the position of
-
' the file pointer after the write operation is finished.
-
'
-
Declare Function WriteFile Lib "kernel32" _
-
(ByVal hFile As Long, ByVal lpBuffer As String, _
-
ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
-
lpOverlapped As OVERLAPPED) As Long
-
-
'-------------------------------------------------------------------------------
-
' Program Constants
-
'-------------------------------------------------------------------------------
-
-
Private Const MAX_PORTS = 4
-
-
'-------------------------------------------------------------------------------
-
' Program Structures
-
'-------------------------------------------------------------------------------
-
-
Private Type COMM_ERROR
-
lngErrorCode As Long
-
strFunction As String
-
strErrorMessage As String
-
End Type
-
-
Private Type COMM_PORT
-
lngHandle As Long
-
blnPortOpen As Boolean
-
udtDCB As DCB
-
End Type
-
-
'-------------------------------------------------------------------------------
-
' Program Storage
-
'-------------------------------------------------------------------------------
-
-
Private udtCommOverlap As OVERLAPPED
-
Private udtCommError As COMM_ERROR
-
Private udtPorts(1 To MAX_PORTS) As COMM_PORT
-
'-------------------------------------------------------------------------------
-
' GetSystemMessage - Gets system error text for the specified error code.
-
'-------------------------------------------------------------------------------
-
Public Function GetSystemMessage(lngErrorCode As Long) As String
-
Dim intPos As Integer
-
Dim strMessage As String, strMsgBuff As String * 256
-
-
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, lngErrorCode, 0, strMsgBuff, 255, 0)
-
-
intPos = InStr(1, strMsgBuff, vbNullChar)
-
If intPos > 0 Then
-
strMessage = Trim$(Left$(strMsgBuff, intPos - 1))
-
Else
-
strMessage = Trim$(strMsgBuff)
-
End If
-
-
GetSystemMessage = strMessage
-
-
End Function
-
-
-
'-------------------------------------------------------------------------------
-
' CommOpen - Opens/Initializes serial port.
-
'
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
' strPort - COM port name. (COM1, COM2, COM3, COM4)
-
' strSettings - Communication settings.
-
' Example: "baud=9600 parity=N data=8 stop=1"
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'
-
'-------------------------------------------------------------------------------
-
Public Function CommOpen(intPortID As Integer, strPort As String, _
-
strSettings As String) As Long
-
-
Dim lngStatus As Long
-
Dim udtCommTimeOuts As COMMTIMEOUTS
-
-
On Error GoTo Routine_Error
-
-
' See if port already in use.
-
If udtPorts(intPortID).blnPortOpen Then
-
lngStatus = -1
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommOpen"
-
.strErrorMessage = "Port in use."
-
End With
-
-
GoTo Routine_Exit
-
End If
-
-
' Open serial port.
-
udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or _
-
GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
-
-
If udtPorts(intPortID).lngHandle = -1 Then
-
lngStatus = SetCommError("CommOpen (CreateFile)")
-
GoTo Routine_Exit
-
End If
-
-
udtPorts(intPortID).blnPortOpen = True
-
-
' Setup device buffers (1K each).
-
lngStatus = SetupComm(udtPorts(intPortID).lngHandle, 1024, 1024)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (SetupComm)")
-
GoTo Routine_Exit
-
End If
-
-
' Purge buffers.
-
lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
-
PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (PurgeComm)")
-
GoTo Routine_Exit
-
End If
-
-
' Set serial port timeouts.
-
With udtCommTimeOuts
-
.ReadIntervalTimeout = -1
-
.ReadTotalTimeoutMultiplier = 0
-
.ReadTotalTimeoutConstant = 1000
-
.WriteTotalTimeoutMultiplier = 0
-
.WriteTotalTimeoutMultiplier = 1000
-
End With
-
-
lngStatus = SetCommTimeouts(udtPorts(intPortID).lngHandle, udtCommTimeOuts)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (SetCommTimeouts)")
-
GoTo Routine_Exit
-
End If
-
-
' Get the current state (DCB).
-
lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
-
udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (GetCommState)")
-
GoTo Routine_Exit
-
End If
-
-
' Modify the DCB to reflect the desired settings.
-
lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (BuildCommDCB)")
-
GoTo Routine_Exit
-
End If
-
-
' Set the new state.
-
lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
-
udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommOpen (SetCommState)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommOpen = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommOpen"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
-
Private Function SetCommError(strFunction As String) As Long
-
-
With udtCommError
-
.lngErrorCode = Err.LastDllError
-
.strFunction = strFunction
-
.strErrorMessage = GetSystemMessage(.lngErrorCode)
-
SetCommError = .lngErrorCode
-
End With
-
-
End Function
-
-
Private Function SetCommErrorEx(strFunction As String, lngHnd As Long) As Long
-
Dim lngErrorFlags As Long
-
Dim udtCommStat As COMSTAT
-
-
With udtCommError
-
.lngErrorCode = GetLastError
-
.strFunction = strFunction
-
.strErrorMessage = GetSystemMessage(.lngErrorCode)
-
-
Call ClearCommError(lngHnd, lngErrorFlags, udtCommStat)
-
-
.strErrorMessage = .strErrorMessage & " COMM Error Flags = " & _
-
Hex$(lngErrorFlags)
-
-
SetCommErrorEx = .lngErrorCode
-
End With
-
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' CommSet - Modifies the serial port settings.
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
' strSettings - Communication settings.
-
' Example: "baud=9600 parity=N data=8 stop=1"
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'-------------------------------------------------------------------------------
-
Public Function CommSet(intPortID As Integer, strSettings As String) As Long
-
-
Dim lngStatus As Long
-
-
On Error GoTo Routine_Error
-
-
lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
-
udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommSet (GetCommState)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommSet (BuildCommDCB)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
-
udtPorts(intPortID).udtDCB)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommSet (SetCommState)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommSet = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommSet"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' CommClose - Close the serial port.
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'-------------------------------------------------------------------------------
-
Public Function CommClose(intPortID As Integer) As Long
-
-
Dim lngStatus As Long
-
-
On Error GoTo Routine_Error
-
-
If udtPorts(intPortID).blnPortOpen Then
-
lngStatus = CloseHandle(udtPorts(intPortID).lngHandle)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommClose (CloseHandle)")
-
GoTo Routine_Exit
-
End If
-
-
udtPorts(intPortID).blnPortOpen = False
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommClose = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommClose"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' CommFlush - Flush the send and receive serial port buffers.
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'-------------------------------------------------------------------------------
-
Public Function CommFlush(intPortID As Integer) As Long
-
-
Dim lngStatus As Long
-
-
On Error GoTo Routine_Error
-
-
lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
-
PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommFlush (PurgeComm)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommFlush = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommFlush"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' 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
-
-
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
-
-
'-------------------------------------------------------------------------------
-
' CommGetLine - Get the state of selected serial port control lines.
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
' intLine - Serial port line. CTS, DSR, RING, RLSD (CD)
-
' blnState - Returns state of line (Cleared or Set).
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'-------------------------------------------------------------------------------
-
Public Function CommGetLine(intPortID As Integer, intLine As Integer, _
-
blnState As Boolean) As Long
-
-
Dim lngStatus As Long
-
Dim lngComStatus As Long, lngModemStatus As Long
-
-
On Error GoTo Routine_Error
-
-
lngStatus = GetCommModemStatus(udtPorts(intPortID).lngHandle, lngModemStatus)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommReadCD (GetCommModemStatus)")
-
GoTo Routine_Exit
-
End If
-
-
If (lngModemStatus And intLine) Then
-
blnState = True
-
Else
-
blnState = False
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommGetLine = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommReadCD"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' CommSetLine - Set the state of selected serial port control lines.
-
'
-
' Parameters:
-
' intPortID - Port ID used when port was opened.
-
' intLine - Serial port line. BREAK, DTR, RTS
-
' Note: BREAK actually sets or clears a "break" condition on
-
' the transmit data line.
-
' blnState - Sets the state of line (Cleared or Set).
-
'
-
' Returns:
-
' Error Code - 0 = No Error.
-
'-------------------------------------------------------------------------------
-
Public Function CommSetLine(intPortID As Integer, intLine As Integer, _
-
blnState As Boolean) As Long
-
-
Dim lngStatus As Long
-
Dim lngNewState As Long
-
-
On Error GoTo Routine_Error
-
-
If intLine = LINE_BREAK Then
-
If blnState Then
-
lngNewState = SETBREAK
-
Else
-
lngNewState = CLRBREAK
-
End If
-
-
ElseIf intLine = LINE_DTR Then
-
If blnState Then
-
lngNewState = SETDTR
-
Else
-
lngNewState = CLRDTR
-
End If
-
-
ElseIf intLine = LINE_RTS Then
-
If blnState Then
-
lngNewState = SETRTS
-
Else
-
lngNewState = CLRRTS
-
End If
-
End If
-
-
lngStatus = EscapeCommFunction(udtPorts(intPortID).lngHandle, lngNewState)
-
-
If lngStatus = 0 Then
-
lngStatus = SetCommError("CommSetLine (EscapeCommFunction)")
-
GoTo Routine_Exit
-
End If
-
-
lngStatus = 0
-
-
Routine_Exit:
-
CommSetLine = lngStatus
-
Exit Function
-
-
Routine_Error:
-
lngStatus = Err.Number
-
With udtCommError
-
.lngErrorCode = lngStatus
-
.strFunction = "CommSetLine"
-
.strErrorMessage = Err.Description
-
End With
-
Resume Routine_Exit
-
End Function
-
-
'-------------------------------------------------------------------------------
-
' CommGetError - Get the last serial port error message.
-
'
-
' Parameters:
-
' strMessage - Error message from last serial port error.
-
'
-
' Returns:
-
' Error Code - Last serial port error code.
-
'-------------------------------------------------------------------------------
-
Public Function CommGetError(strMessage As String) As Long
-
-
With udtCommError
-
CommGetError = .lngErrorCode
-
strMessage = "Error (" & CStr(.lngErrorCode) & "): " & .strFunction & _
-
" - " & .strErrorMessage
-
End With
-
-
End Function
-
-
-
When I tried this I didn't get any response from the receiving equipment. I'm going to try and use the easier version, using the standard i/o. I'll let you know if it works better. If you see anything funny in the module code let me know.
Thanks for all the help.
I was able to get this to work. I had to send as a byte to the machine so this is what I sent - VchkSum = 200 + 30 + CmbBedDesc + VTimeused + Vmode + VbedDel
-
strdata = Chr(200) + Chr(30) + Chr(CmbBedDesc) + Chr(VTimeused) + Chr(Vmode) + Chr(VbedDel) + Chr(0) + Chr(VchkSum)
-
That worked, when receiving back info from the machine I was told to create a array and then when the bytes come back from the machine to put those into the array. So here's what I do
Then run the CommRead and when it returns the data I was supposed to put that into the rxarray so this is what I do
. Here's my question how do I read the rxarray, I've never used a array so I'm at a loss. Again any help is appreciated. The CommRead is in the CommMod listed in a previous post
This might work for you: - Dim sString AS String
-
sString = StrConv(rxarray, vbProperCase)
I'll give that a try and let you know. Thanks
I gave that sString a try but only got back blank. I don't know if it's worth continuing trying to get this to work.
Sorry to hear that. Maybe it is blank?
Something that I would check though is to put the in break mode and see what is in the array with a print statement in the immediate window: - ?ubound(rxarray)
-
?rxarray(1)
I wouldn't think you have to resort to iterating through the array, but it's possible... using a for next loop with lbound and ubound: - Dim iCount As Integer
-
For iCount = LBound(rxarray) To UBound(rxarray)-1
-
Debug.Print rxarray(iCount)
-
Next iCount
Lastly, do you have to use the comm port? If the computer you are talking to is on a network, there's some other ways you can attempt to communicate to it. Or zmdb's post looks promising.
I worked on a project talking over serial port about 10 years ago in c#.net 1.1 and it was kind of a nightmare as it was very finicky an easily locked up the program.
NeoPa 32,556
Expert Mod 16PB CD Tom:
Then run the CommRead and when it returns the data I was supposed to put that into the rxarray so ...
Really? I can't imagine what would require you to add the data into an array yourself. I can believe that CommRead() might well return the data in a Byte array, but that's a far cry from what you say. Please clarify. CD Tom:
Here's my question how do I read the rxarray, I've never used a array so I'm at a loss.
Moving a string into a Byte array can be done with code similar to : - Private Sub StringToByte(ByRef abytVar() As Byte, ByVal strVar as String)
-
Dim lngVar As Long
-
-
ReDim abytVar(0 To Len(strVar) - 1)
-
For lngVar = 1 To Len(strVar)
-
abytVar(lngVar - 1) = Asc(Mid(strVar, lngVar))
-
Next lngVar
-
End Sub
Moving a Byte array into a string can be done with code similar to : - Private Function ByteToString(ByRef abytVar() As Byte) as String
-
Dim lngVar As Long
-
-
For lngVar = LBound(abytVar) To UBound(abytVar)
-
ByteToString = ByteToString & Chr(abytVar(lngVar))
-
Next lngVar
-
End Sub
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Chris |
last post by:
Here's the situation:
I work at a scientific institution and I have a portable electronic
device which is used to take measurements. The device produces a very
small amount of numerical data,...
|
by: Dan |
last post by:
I wnat to see in browser an status from an device connected on rs232
port
The java class for read from serial port is:
//Serial.java
import java.io.*;
import java.util.*;
import...
|
by: Ramakant Kasar |
last post by:
Hi,
If an application is reading data from a serial port, How can I open the
same serial port with another application?
Any idea? Please help.
Thanks,
Ramakant K.
|
by: jyotish.bora |
last post by:
Hi ,
i m trying to send a message packet to a RS232 port. I have created the
handle and set the parameters. Now the general format of the packet is
<STX>command<ETX><LRC>
I have also written...
|
by: johnfotl |
last post by:
How can I get data from an RS232 port in VB6?
|
by: colin |
last post by:
Hi,
Im having a tiresome amount of trouble with using a bluetooth serial link.
The receiving end is a bluetooth-rs232 module conected to my embeded system.
The PC has a little usb bluetooth...
|
by: Canuno |
last post by:
Hi, I'm trying to send a small string to a serial port rs232 located in com 4.
the string is: "ST GA#Ž"
The Baud Rate is: 38400
Parity: None
Data Bits: 8
Stops Bits: 1
Flow Control: None...
|
by: jeekesh |
last post by:
Hi
I am very new to java.
I have made one application for inventory mgmt.
I want some ready code to read data from barcode scanner or rs232 port.
If any of have such code than please help me
|
by: Dave067 |
last post by:
Hi
I'm a Python newbie trying to write a datalogger to acquire data from a laboratory meter using RS232.
Hardware: Samsung N100 laptop. Maplin's USB-Serial converter dongle. TSI 4100 series...
|
by: RacingSalmander |
last post by:
Hi all,
I am trying to import a compressed array from a RS232 port to a UBS jumpdrive in the Java language. Please can you help me by giving me some advice in which direction to tackle this...
|
by: Charles Arthur |
last post by:
How do i turn on java script on a villaon, callus and itel keypad mobile phone
|
by: ryjfgjl |
last post by:
In our work, we often receive Excel tables with data in the same format. If we want to analyze these data, it can be difficult to analyze them because the data is spread across multiple Excel files...
|
by: BarryA |
last post by:
What are the essential steps and strategies outlined in the Data Structures and Algorithms (DSA) roadmap for aspiring data scientists? How can individuals effectively utilize this roadmap to progress...
|
by: nemocccc |
last post by:
hello, everyone, I want to develop a software for my android phone for daily needs, any suggestions?
|
by: Hystou |
last post by:
There are some requirements for setting up RAID:
1. The motherboard and BIOS support RAID configuration.
2. The motherboard has 2 or more available SATA protocol SSD/HDD slots (including MSATA, M.2...
|
by: marktang |
last post by:
ONU (Optical Network Unit) is one of the key components for providing high-speed Internet services. Its primary function is to act as an endpoint device located at the user's premises. However,...
|
by: Hystou |
last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can...
|
by: Oralloy |
last post by:
Hello folks,
I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>".
The problem is that using the GNU compilers,...
|
by: Hystou |
last post by:
Overview:
Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows...
| |