'---------------BEGIN-OF-DECLARATIONS------------------------------------------------------------------------------
Private Type DCB
DCBlength As Long
BaudRate As Long
fBitFields As Long
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
End Type
' The structure of the fBitFields field.
' FieldName Bit # Description
' ----------------- ----- ------------------------------
' fBinary 1 Windows does not support nonbinary mode transfers, so this member must be =1.
' fParity 2 If =1, parity checking is performed and errors are reported
' fOutxCtsFlow 3 If =1 and CTS is turned off, output is suspended until CTS is sent again.
' fOutxDsrFlow 4 If =1 and DSR is turned off, output is suspended until DSR is sent again.
' fDtrControl 5,6 DTR flow control (2 bits)
' fDsrSensitivity 7 The driver ignores any bytes received, unless the DSR modem input line is high.
' fTXContinueOnXoff 8 XOFF continues Tx
' fOutX 9 If =1, TX stops when the XoffChar character is received and starts again when the XonChar character is received.
' fInX 10 Indicates whether XON/XOFF flow control is used during reception.
' fErrorChar 11 Indicates whether bytes received with parity errors are replaced with the character specified by the ErrorChar.
' fNull 12 If =1, null bytes are discarded when received.
' fRtsControl 13,14 RTS flow control (2 bits)
' fAbortOnError 15 If =1, the driver terminates all I/O operations with an error status if an error occurs.
' fDummy2 16 reserved
'---------fBitFields-------------
Const F_BINARY = 1
Const F_PARITY = 2
Const F_OUTX_CTS_FLOW = 4
Const F_OUTX_DSR_FLOW = 8
'DTR Control Flow Values.
Const F_DTR_CONTROL_ENABLE = &H10
Const F_DTR_CONTROL_HANDSHAKE = &H20
Const F_DSR_SENSITIVITY = &H40
Const F_TX_CONTINUE_ON_XOFF = &H80
Const F_OUT_X = &H100
Const F_IN_X = &H200
Const F_ERROR_CHAR = &H400
Const F_NULL = &H800
'RTS Control Flow Values
Const F_RTS_CONTROL_ENABLE = &H1000
Const F_RTS_CONTROL_HANDSHAKE = &H2000
Const F_RTS_CONTROL_TOGGLE = &H3000
Const F_ABORT_ON_ERROR = &H4000
'---------Parity flags--------
Const EVENPARITY = 2
Const MARKPARITY = 3
Const NOPARITY = 0
Const ODDPARITY = 1
Const SPACEPARITY = 4
'---------StopBits-----------
Const ONESTOPBIT = 0
Const ONE5STOPBITS = 1
Const TWOSTOPBITS = 2
'-----------------------------------------------------------------------------------------------
Private Type COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End Type
'-----------------------------------------------------------------------------------------------
'Constants for the dwDesiredAccess parameter of the CreateFile() function
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
'Constants for the dwShareMode parameter of the CreateFile() function
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
'Constants for the dwCreationDisposition parameter of the CreateFile() function
Const CREATE_NEW = 1
Const CREATE_ALWAYS = 2
Const OPEN_EXISTING = 3
'Constants for the dwFlagsAndAttributes parameter of the CreateFile() function
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_FLAG_OVERLAPPED = &H40000000
'-----------------------------------------------------------------------------------------------
'Error codes reported by the CreateFile().
'More error codes with descriptions are available at MSDN
Const ERROR_FILE_NOT_FOUND = 2
Const ERROR_ACCESS_DENIED = 5
Const ERROR_INVALID_HANDLE = 6
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hFile As Long, lpDCB As DCB) As Long
Private Declare Function GetCommState Lib "kernel32" (ByVal hFile 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 GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, _
lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) _
As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
'---------------END-OF-DECLARATIONS------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
'Public Sub Init_Com()
Dim rc As Long
Dim h As Long
h = CreateFile("\\.\COM7", GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, 0)
'For serial port numbers higher than 9 see KB115831
If h = -1 Then
rc = Err.LastDllError
Select Case rc 'Two typical error codes when trying to open a serial port:
Case ERROR_ACCESS_DENIED ' - The serial port opened by another application
MsgBox "The serial port is used by another program"
Case ERROR_FILE_NOT_FOUND ' - The serial port does not exist, check the port name specified in the CreateFile()
MsgBox "The serial port does not exist"
Case Else
MsgBox "CreateFile failed, the error code is " & Str(rc)
End Select
Exit Sub
End If
Dim d As DCB 'The DCB structure and the SetCommState() function allow to set the baud rate and the byte size of the serial port.
rc = GetCommState(h, d)
d.ByteSize = 8
d.BaudRate = 19200
d.fBitFields = F_BINARY 'Windows does not support non-binary data transfers so the flag must always be set in the DCB structure.
'Another example how to set some flags in the DCB.
'd.fBitFields = F_BINARY Or F_PARITY Or F_RTS_CONTROL_ENABLE
d.StopBits = ONESTOPBIT
d.Parity = NOPARITY
rc = SetCommState(h, d)
If rc = 0 Then
rc = Err.LastDllError
MsgBox "SetCommState failed, the error code is " & Str(rc)
End If
Dim timeouts As COMMTIMEOUTS 'Because we don't want communication timeouts to hang the VB code,
rc = GetCommTimeouts(h, timeouts) 'we need to specify the maximum time Windows will wait for incoming data
timeouts.ReadIntervalTimeout = 3 'The max. time in milliseconds between arrival of any two bytes
timeouts.ReadTotalTimeoutConstant = 20 'The max. time the ReadFile() function will wait for data.
timeouts.ReadTotalTimeoutMultiplier = 0
rc = SetCommTimeouts(h, timeouts)
If rc = 0 Then
rc = Err.LastDllError
MsgBox "SetCommTimeouts failed, the error code is " & Str(rc)
GoTo close_and_exit
End If
Dim bWrite(1 To 10) As Byte 'Sending an array of 3 bytes to a remote device.
bWrite(1) = &H47
bWrite(2) = &H50
bWrite(3) = &H20
bWrite(4) = &H53
bWrite(5) = &H54
bWrite(6) = &H41
bWrite(7) = &H54
bWrite(8) = &H55
bWrite(9) = &H53
bWrite(10) = &HD
Dim wr As Long
rc = WriteFile(h, bWrite(1), 10, wr, 0) 'wr indicates how many bytes went to the port.
If rc = 0 Then
rc = Err.LastDllError
MsgBox "WriteFile failed, the error code is " & Str(rc)
GoTo close_and_exit
End If
'Now we want to receive an answer from the remote device.
Dim bRead(1 To 23) As Byte 'We want to receive up to 10 bytes.
Dim rd As Long
rc = ReadFile(h, bRead(1), 23, rd, 0) 'rd indicates how many bytes received from the port.
If rc = 0 Then
rc = Err.LastDllError
MsgBox "ReadFile failed, the error code is " & Str(rc)
GoTo close_and_exit
End If
Dim s As String 'Printing the received data in hexadecimal form.
Dim i As Long
For i = 1 To rd
s = s & Chr(bRead(i))
Next i
MsgBox s
close_and_exit:
rc = CloseHandle(h) 'In VBA, always execute this call. Or you will receive the ERROR_ACCESS_DENIED next time then opening the port
'and you will need to reload Word/Excel/Access to free the port.
End Sub
Saturday, November 19, 2016
Serial Port Access using Excel
This example is mainly taken from :https://strokescribe.com/en/serial-port-vb-winapi.html#code. It uses WinAPI functions https://msdn.microsoft.com/en-us/library/172wfck9.aspx, http://www.informit.com/articles/article.aspx?p=366892 Not that the begining of the code is all the declarations more than half the code. The actual usage is in the line: starting with "Private Sub CommandButton1_Click().
Subscribe to:
Post Comments (Atom)
JSP - Java Description
https://docs.oracle.com/javaee/5/tutorial/doc/bnair.html Install Java on the computer: https://phoenixnap.com/kb/install-java-windows Insta...
-
In a regular annotation note, create a stack that looks the way you like. It will take a couple of trial and error attempts since there'...
-
I just finished a 1 hour marketing meeting with an organization that I volunteer with. They are trying to create an new website and the look...
Excel is my favourite programme to work and it seems to me that I am on th eright track.
ReplyDeleteI found one successful example of this truth through this blog. I am going to use such information now. Case Converter
ReplyDelete