By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,963 Members | 2,016 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,963 IT Pros & Developers. It's quick & easy.

Output to a RS232 Port.

100+
P: 462
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.
Apr 10 '15 #1
Share this Question
Share on Google+
11 Replies


NeoPa
Expert Mod 15k+
P: 31,769
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?
Apr 11 '15 #2

100+
P: 462
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
Expand|Select|Wrap|Line Numbers
  1.  Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
  2.     Dim lngStatus As Long
  3.     Dim strError  As String
  4.     Dim strData   As String
  5.  
  6.  
  7.     ' Initialize Communications
  8.     lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
  9.         "baud=9600 parity=N data=8 stop=1")
  10.  
  11.     If lngStatus <> 0 Then
  12.     ' Handle error.
  13.         lngStatus = CommGetError(strError)
  14.     MsgBox "COM Error: " & strError
  15.     End If
  16.  
  17.  
  18.     ' Set modem control lines.
  19.     lngStatus = CommSetLine(intPortID, LINE_RTS, True)
  20.     lngStatus = CommSetLine(intPortID, LINE_DTR, True)
  21.  
  22.     ' Write data to serial port.
  23.     lngSize = Len(strData)
  24.     lngStatus = CommWrite(intPortID, strData)
  25.     If lngStatus <> lngSize Then
  26.     ' Handle error.
  27.     End If
  28.  
  29.  
  30.  
  31.     ' Read maximum of 64 bytes from serial port.
  32.     lngStatus = CommRead(intPortID, strData, 64)
  33.     If lngStatus > 0 Then
  34.         ' Process data.
  35.     ElseIf lngStatus < 0 Then
  36.         ' Handle error.
  37.     End If
  38.  
  39.     ' Reset modem control lines.
  40.     lngStatus = CommSetLine(intPortID, LINE_RTS, False)
  41.     lngStatus = CommSetLine(intPortID, LINE_DTR, False)
  42.  
  43.  
  44.  
  45.     ' Close communications.
  46.     Call CommClose(intPortID)
  47.  
the .bas is quite large if you want me to add it let me know.

Thanks for the reply and any help
Apr 11 '15 #3

NeoPa
Expert Mod 15k+
P: 31,769
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.
Apr 12 '15 #4

zmbd
Expert Mod 5K+
P: 5,397
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))))
Expand|Select|Wrap|Line Numbers
  1. Dim zOpenPort as Integer
  2. Dim zrecord as string * 8 '8bytes?
  3. '
  4. zopenport = freefile
  5. 'open com1 at 2400B 8bit no parity 1 stop bit
  6. 'you will need to change the com-port to match where
  7. 'you've connected.
  8. Open "COM1:2400,N,8,1" for random as zopenport
  9. '
  10. 'Ok from here... I'm skechy... we can use write, get, etc...
  11. 'to push/pull the data. Just depends on things... 
  12. '
  13.  
Then there's the MSCOMM control in Visual Basic... haven't checked to see if it's available in MSAccessVBA
Apr 15 '15 #5

100+
P: 462
I do have a class module see code.
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. 'Attribute VB_Name = "modCOMM"
  4. Option Explicit
  5.  
  6. '-------------------------------------------------------------------------------
  7. ' modCOMM - Written by: David M. Hitchner
  8. '
  9. ' This VB module is a collection of routines to perform serial port I/O without
  10. ' using the Microsoft Comm Control component.  This module uses the Windows API
  11. ' to perform the overlapped I/O operations necessary for serial communications.
  12. '
  13. ' The routine can handle up to 4 serial ports which are identified with a
  14. ' Port ID.
  15. '
  16. ' All routines (with the exception of CommRead and CommWrite) return an error
  17. ' code or 0 if no error occurs.  The routine CommGetError can be used to get
  18. ' the complete error message.
  19. '-------------------------------------------------------------------------------
  20.  
  21. '-------------------------------------------------------------------------------
  22. ' Public Constants
  23. '-------------------------------------------------------------------------------
  24.  
  25. ' Output Control Lines (CommSetLine)
  26. Public Const LINE_BREAK = 1
  27. Public Const LINE_DTR = 2
  28. Public Const LINE_RTS = 3
  29.  
  30. ' Input Control Lines  (CommGetLine)
  31. Public Const LINE_CTS = &H10&
  32. Public Const LINE_DSR = &H20&
  33. Public Const LINE_RING = &H40&
  34. Public Const LINE_RLSD = &H80&
  35. Public Const LINE_CD = &H80&
  36.  
  37. '-------------------------------------------------------------------------------
  38. ' System Constants
  39. '-------------------------------------------------------------------------------
  40. Private Const ERROR_IO_INCOMPLETE = 996&
  41. Private Const ERROR_IO_PENDING = 997
  42. Private Const GENERIC_READ = &H80000000
  43. Private Const GENERIC_WRITE = &H40000000
  44. Private Const FILE_ATTRIBUTE_NORMAL = &H80
  45. Private Const FILE_FLAG_OVERLAPPED = &H40000000
  46. Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  47. Private Const OPEN_EXISTING = 3
  48.  
  49. ' COMM Functions
  50. Private Const MS_CTS_ON = &H10&
  51. Private Const MS_DSR_ON = &H20&
  52. Private Const MS_RING_ON = &H40&
  53. Private Const MS_RLSD_ON = &H80&
  54. Private Const PURGE_RXABORT = &H2
  55. Private Const PURGE_RXCLEAR = &H8
  56. Private Const PURGE_TXABORT = &H1
  57. Private Const PURGE_TXCLEAR = &H4
  58.  
  59. ' COMM Escape Functions
  60. Private Const CLRBREAK = 9
  61. Private Const CLRDTR = 6
  62. Private Const CLRRTS = 4
  63. Private Const SETBREAK = 8
  64. Private Const SETDTR = 5
  65. Private Const SETRTS = 3
  66.  
  67. '-------------------------------------------------------------------------------
  68. ' System Structures
  69. '-------------------------------------------------------------------------------
  70. Private Type COMSTAT
  71.         fBitFields As Long ' See Comment in Win32API.Txt
  72.         cbInQue As Long
  73.         cbOutQue As Long
  74. End Type
  75.  
  76. Private Type COMMTIMEOUTS
  77.         ReadIntervalTimeout As Long
  78.         ReadTotalTimeoutMultiplier As Long
  79.         ReadTotalTimeoutConstant As Long
  80.         WriteTotalTimeoutMultiplier As Long
  81.         WriteTotalTimeoutConstant As Long
  82. End Type
  83.  
  84. '
  85. ' The DCB structure defines the control setting for a serial
  86. ' communications device.
  87. '
  88. Private Type DCB
  89.         DCBlength As Long
  90.         BaudRate As Long
  91.         fBitFields As Long ' See Comments in Win32API.Txt
  92.         wReserved As Integer
  93.         XonLim As Integer
  94.         XoffLim As Integer
  95.         ByteSize As Byte
  96.         Parity As Byte
  97.         StopBits As Byte
  98.         XonChar As Byte
  99.         XoffChar As Byte
  100.         ErrorChar As Byte
  101.         EofChar As Byte
  102.         EvtChar As Byte
  103.         wReserved1 As Integer 'Reserved; Do Not Use
  104. End Type
  105.  
  106. Private Type OVERLAPPED
  107.         Internal As Long
  108.         InternalHigh As Long
  109.         offset As Long
  110.         OffsetHigh As Long
  111.         hEvent As Long
  112. End Type
  113.  
  114. Private Type SECURITY_ATTRIBUTES
  115.         nLength As Long
  116.         lpSecurityDescriptor As Long
  117.         bInheritHandle As Long
  118. End Type
  119.  
  120. '-------------------------------------------------------------------------------
  121. ' System Functions
  122. '-------------------------------------------------------------------------------
  123. '
  124. ' Fills a specified DCB structure with values specified in
  125. ' a device-control string.
  126. '
  127. Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" _
  128.     (ByVal lpDef As String, lpDCB As DCB) As Long
  129. '
  130. ' Retrieves information about a communications error and reports
  131. ' the current status of a communications device. The function is
  132. ' called when a communications error occurs, and it clears the
  133. ' device's error flag to enable additional input and output
  134. ' (I/O) operations.
  135. '
  136. Declare Function ClearCommError Lib "kernel32" _
  137.     (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
  138. '
  139. ' Closes an open communications device or file handle.
  140. '
  141. Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  142. '
  143. ' Creates or opens a communications resource and returns a handle
  144. ' that can be used to access the resource.
  145. '
  146. Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
  147.     (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
  148.     ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
  149.     ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
  150.     ByVal hTemplateFile As Long) As Long
  151. '
  152. ' Directs a specified communications device to perform a function.
  153. '
  154. Declare Function EscapeCommFunction Lib "kernel32" _
  155.     (ByVal nCid As Long, ByVal nFunc As Long) As Long
  156. '
  157. ' Formats a message string such as an error string returned
  158. ' by anoher function.
  159. '
  160. Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
  161.     (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
  162.     ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
  163.     Arguments As Long) As Long
  164. '
  165. ' Retrieves modem control-register values.
  166. '
  167. Declare Function GetCommModemStatus Lib "kernel32" _
  168.     (ByVal hFile As Long, lpModemStat As Long) As Long
  169. '
  170. ' Retrieves the current control settings for a specified
  171. ' communications device.
  172. '
  173. Declare Function GetCommState Lib "kernel32" _
  174.     (ByVal nCid As Long, lpDCB As DCB) As Long
  175. '
  176. ' Retrieves the calling thread's last-error code value.
  177. '
  178. Declare Function GetLastError Lib "kernel32" () As Long
  179. '
  180. ' Retrieves the results of an overlapped operation on the
  181. ' specified file, named pipe, or communications device.
  182. '
  183. Declare Function GetOverlappedResult Lib "kernel32" _
  184.     (ByVal hFile As Long, lpOverlapped As OVERLAPPED, _
  185.     lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long
  186. '
  187. ' Discards all characters from the output or input buffer of a
  188. ' specified communications resource. It can also terminate
  189. ' pending read or write operations on the resource.
  190. '
  191. Declare Function PurgeComm Lib "kernel32" _
  192.     (ByVal hFile As Long, ByVal dwFlags As Long) As Long
  193. '
  194. ' Reads data from a file, starting at the position indicated by the
  195. ' file pointer. After the read operation has been completed, the
  196. ' file pointer is adjusted by the number of bytes actually read,
  197. ' unless the file handle is created with the overlapped attribute.
  198. ' If the file handle is created for overlapped input and output
  199. ' (I/O), the application must adjust the position of the file pointer
  200. ' after the read operation.
  201. '
  202. Declare Function ReadFile Lib "kernel32" _
  203.     (ByVal hFile As Long, ByVal lpBuffer As String, _
  204.     ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, _
  205.     lpOverlapped As OVERLAPPED) As Long
  206. '
  207. ' Configures a communications device according to the specifications
  208. ' in a device-control block (a DCB structure). The function
  209. ' reinitializes all hardware and control settings, but it does not
  210. ' empty output or input queues.
  211. '
  212. Declare Function SetCommState Lib "kernel32" _
  213.     (ByVal hCommDev As Long, lpDCB As DCB) As Long
  214. '
  215. ' Sets the time-out parameters for all read and write operations on a
  216. ' specified communications device.
  217. '
  218. Declare Function SetCommTimeouts Lib "kernel32" _
  219.     (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
  220. '
  221. ' Initializes the communications parameters for a specified
  222. ' communications device.
  223. '
  224. Declare Function SetupComm Lib "kernel32" _
  225.     (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
  226. '
  227. ' Writes data to a file and is designed for both synchronous and a
  228. ' synchronous operation. The function starts writing data to the file
  229. ' at the position indicated by the file pointer. After the write
  230. ' operation has been completed, the file pointer is adjusted by the
  231. ' number of bytes actually written, except when the file is opened with
  232. ' FILE_FLAG_OVERLAPPED. If the file handle was created for overlapped
  233. ' input and output (I/O), the application must adjust the position of
  234. ' the file pointer after the write operation is finished.
  235. '
  236. Declare Function WriteFile Lib "kernel32" _
  237.     (ByVal hFile As Long, ByVal lpBuffer As String, _
  238.     ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
  239.     lpOverlapped As OVERLAPPED) As Long
  240.  
  241. '-------------------------------------------------------------------------------
  242. ' Program Constants
  243. '-------------------------------------------------------------------------------
  244.  
  245. Private Const MAX_PORTS = 4
  246.  
  247. '-------------------------------------------------------------------------------
  248. ' Program Structures
  249. '-------------------------------------------------------------------------------
  250.  
  251. Private Type COMM_ERROR
  252.     lngErrorCode As Long
  253.     strFunction As String
  254.     strErrorMessage As String
  255. End Type
  256.  
  257. Private Type COMM_PORT
  258.     lngHandle As Long
  259.     blnPortOpen As Boolean
  260.     udtDCB As DCB
  261. End Type
  262.  
  263. '-------------------------------------------------------------------------------
  264. ' Program Storage
  265. '-------------------------------------------------------------------------------
  266.  
  267. Private udtCommOverlap As OVERLAPPED
  268. Private udtCommError As COMM_ERROR
  269. Private udtPorts(1 To MAX_PORTS) As COMM_PORT
  270. '-------------------------------------------------------------------------------
  271. ' GetSystemMessage - Gets system error text for the specified error code.
  272. '-------------------------------------------------------------------------------
  273. Public Function GetSystemMessage(lngErrorCode As Long) As String
  274. Dim intPos As Integer
  275. Dim strMessage As String, strMsgBuff As String * 256
  276.  
  277.     Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, lngErrorCode, 0, strMsgBuff, 255, 0)
  278.  
  279.     intPos = InStr(1, strMsgBuff, vbNullChar)
  280.     If intPos > 0 Then
  281.         strMessage = Trim$(Left$(strMsgBuff, intPos - 1))
  282.     Else
  283.         strMessage = Trim$(strMsgBuff)
  284.     End If
  285.  
  286.     GetSystemMessage = strMessage
  287.  
  288. End Function
  289.  
  290.  
  291. '-------------------------------------------------------------------------------
  292. ' CommOpen - Opens/Initializes serial port.
  293. '
  294. '
  295. ' Parameters:
  296. '   intPortID   - Port ID used when port was opened.
  297. '   strPort     - COM port name. (COM1, COM2, COM3, COM4)
  298. '   strSettings - Communication settings.
  299. '                 Example: "baud=9600 parity=N data=8 stop=1"
  300. '
  301. ' Returns:
  302. '   Error Code  - 0 = No Error.
  303. '
  304. '-------------------------------------------------------------------------------
  305. Public Function CommOpen(intPortID As Integer, strPort As String, _
  306.     strSettings As String) As Long
  307.  
  308. Dim lngStatus       As Long
  309. Dim udtCommTimeOuts As COMMTIMEOUTS
  310.  
  311.     On Error GoTo Routine_Error
  312.  
  313.     ' See if port already in use.
  314.     If udtPorts(intPortID).blnPortOpen Then
  315.         lngStatus = -1
  316.         With udtCommError
  317.             .lngErrorCode = lngStatus
  318.             .strFunction = "CommOpen"
  319.             .strErrorMessage = "Port in use."
  320.         End With
  321.  
  322.         GoTo Routine_Exit
  323.     End If
  324.  
  325.     ' Open serial port.
  326.     udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or _
  327.         GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  328.  
  329.     If udtPorts(intPortID).lngHandle = -1 Then
  330.         lngStatus = SetCommError("CommOpen (CreateFile)")
  331.         GoTo Routine_Exit
  332.     End If
  333.  
  334.     udtPorts(intPortID).blnPortOpen = True
  335.  
  336.     ' Setup device buffers (1K each).
  337.     lngStatus = SetupComm(udtPorts(intPortID).lngHandle, 1024, 1024)
  338.  
  339.     If lngStatus = 0 Then
  340.         lngStatus = SetCommError("CommOpen (SetupComm)")
  341.         GoTo Routine_Exit
  342.     End If
  343.  
  344.     ' Purge buffers.
  345.     lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
  346.         PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)
  347.  
  348.     If lngStatus = 0 Then
  349.         lngStatus = SetCommError("CommOpen (PurgeComm)")
  350.         GoTo Routine_Exit
  351.     End If
  352.  
  353.     ' Set serial port timeouts.
  354.     With udtCommTimeOuts
  355.         .ReadIntervalTimeout = -1
  356.         .ReadTotalTimeoutMultiplier = 0
  357.         .ReadTotalTimeoutConstant = 1000
  358.         .WriteTotalTimeoutMultiplier = 0
  359.         .WriteTotalTimeoutMultiplier = 1000
  360.     End With
  361.  
  362.     lngStatus = SetCommTimeouts(udtPorts(intPortID).lngHandle, udtCommTimeOuts)
  363.  
  364.     If lngStatus = 0 Then
  365.         lngStatus = SetCommError("CommOpen (SetCommTimeouts)")
  366.         GoTo Routine_Exit
  367.     End If
  368.  
  369.     ' Get the current state (DCB).
  370.     lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
  371.         udtPorts(intPortID).udtDCB)
  372.  
  373.     If lngStatus = 0 Then
  374.         lngStatus = SetCommError("CommOpen (GetCommState)")
  375.         GoTo Routine_Exit
  376.     End If
  377.  
  378.     ' Modify the DCB to reflect the desired settings.
  379.     lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)
  380.  
  381.     If lngStatus = 0 Then
  382.         lngStatus = SetCommError("CommOpen (BuildCommDCB)")
  383.         GoTo Routine_Exit
  384.     End If
  385.  
  386.     ' Set the new state.
  387.     lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
  388.         udtPorts(intPortID).udtDCB)
  389.  
  390.     If lngStatus = 0 Then
  391.         lngStatus = SetCommError("CommOpen (SetCommState)")
  392.         GoTo Routine_Exit
  393.     End If
  394.  
  395.     lngStatus = 0
  396.  
  397. Routine_Exit:
  398.     CommOpen = lngStatus
  399.     Exit Function
  400.  
  401. Routine_Error:
  402.     lngStatus = Err.Number
  403.     With udtCommError
  404.         .lngErrorCode = lngStatus
  405.         .strFunction = "CommOpen"
  406.         .strErrorMessage = Err.Description
  407.     End With
  408.     Resume Routine_Exit
  409. End Function
  410.  
  411.  
  412. Private Function SetCommError(strFunction As String) As Long
  413.  
  414.     With udtCommError
  415.         .lngErrorCode = Err.LastDllError
  416.         .strFunction = strFunction
  417.         .strErrorMessage = GetSystemMessage(.lngErrorCode)
  418.         SetCommError = .lngErrorCode
  419.     End With
  420.  
  421. End Function
  422.  
  423. Private Function SetCommErrorEx(strFunction As String, lngHnd As Long) As Long
  424. Dim lngErrorFlags As Long
  425. Dim udtCommStat As COMSTAT
  426.  
  427.     With udtCommError
  428.         .lngErrorCode = GetLastError
  429.         .strFunction = strFunction
  430.         .strErrorMessage = GetSystemMessage(.lngErrorCode)
  431.  
  432.         Call ClearCommError(lngHnd, lngErrorFlags, udtCommStat)
  433.  
  434.         .strErrorMessage = .strErrorMessage & "  COMM Error Flags = " & _
  435.                 Hex$(lngErrorFlags)
  436.  
  437.         SetCommErrorEx = .lngErrorCode
  438.     End With
  439.  
  440. End Function
  441.  
  442. '-------------------------------------------------------------------------------
  443. ' CommSet - Modifies the serial port settings.
  444. '
  445. ' Parameters:
  446. '   intPortID   - Port ID used when port was opened.
  447. '   strSettings - Communication settings.
  448. '                 Example: "baud=9600 parity=N data=8 stop=1"
  449. '
  450. ' Returns:
  451. '   Error Code  - 0 = No Error.
  452. '-------------------------------------------------------------------------------
  453. Public Function CommSet(intPortID As Integer, strSettings As String) As Long
  454.  
  455. Dim lngStatus As Long
  456.  
  457.     On Error GoTo Routine_Error
  458.  
  459.     lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
  460.         udtPorts(intPortID).udtDCB)
  461.  
  462.     If lngStatus = 0 Then
  463.         lngStatus = SetCommError("CommSet (GetCommState)")
  464.         GoTo Routine_Exit
  465.     End If
  466.  
  467.     lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)
  468.  
  469.     If lngStatus = 0 Then
  470.         lngStatus = SetCommError("CommSet (BuildCommDCB)")
  471.         GoTo Routine_Exit
  472.     End If
  473.  
  474.     lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
  475.         udtPorts(intPortID).udtDCB)
  476.  
  477.     If lngStatus = 0 Then
  478.         lngStatus = SetCommError("CommSet (SetCommState)")
  479.         GoTo Routine_Exit
  480.     End If
  481.  
  482.     lngStatus = 0
  483.  
  484. Routine_Exit:
  485.     CommSet = lngStatus
  486.     Exit Function
  487.  
  488. Routine_Error:
  489.     lngStatus = Err.Number
  490.     With udtCommError
  491.         .lngErrorCode = lngStatus
  492.         .strFunction = "CommSet"
  493.         .strErrorMessage = Err.Description
  494.     End With
  495.     Resume Routine_Exit
  496. End Function
  497.  
  498. '-------------------------------------------------------------------------------
  499. ' CommClose - Close the serial port.
  500. '
  501. ' Parameters:
  502. '   intPortID   - Port ID used when port was opened.
  503. '
  504. ' Returns:
  505. '   Error Code  - 0 = No Error.
  506. '-------------------------------------------------------------------------------
  507. Public Function CommClose(intPortID As Integer) As Long
  508.  
  509. Dim lngStatus As Long
  510.  
  511.     On Error GoTo Routine_Error
  512.  
  513.     If udtPorts(intPortID).blnPortOpen Then
  514.         lngStatus = CloseHandle(udtPorts(intPortID).lngHandle)
  515.  
  516.         If lngStatus = 0 Then
  517.             lngStatus = SetCommError("CommClose (CloseHandle)")
  518.             GoTo Routine_Exit
  519.         End If
  520.  
  521.         udtPorts(intPortID).blnPortOpen = False
  522.     End If
  523.  
  524.     lngStatus = 0
  525.  
  526. Routine_Exit:
  527.     CommClose = lngStatus
  528.     Exit Function
  529.  
  530. Routine_Error:
  531.     lngStatus = Err.Number
  532.     With udtCommError
  533.         .lngErrorCode = lngStatus
  534.         .strFunction = "CommClose"
  535.         .strErrorMessage = Err.Description
  536.     End With
  537.     Resume Routine_Exit
  538. End Function
  539.  
  540. '-------------------------------------------------------------------------------
  541. ' CommFlush - Flush the send and receive serial port buffers.
  542. '
  543. ' Parameters:
  544. '   intPortID   - Port ID used when port was opened.
  545. '
  546. ' Returns:
  547. '   Error Code  - 0 = No Error.
  548. '-------------------------------------------------------------------------------
  549. Public Function CommFlush(intPortID As Integer) As Long
  550.  
  551. Dim lngStatus As Long
  552.  
  553.     On Error GoTo Routine_Error
  554.  
  555.     lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
  556.         PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)
  557.  
  558.     If lngStatus = 0 Then
  559.         lngStatus = SetCommError("CommFlush (PurgeComm)")
  560.         GoTo Routine_Exit
  561.     End If
  562.  
  563.     lngStatus = 0
  564.  
  565. Routine_Exit:
  566.     CommFlush = lngStatus
  567.     Exit Function
  568.  
  569. Routine_Error:
  570.     lngStatus = Err.Number
  571.     With udtCommError
  572.         .lngErrorCode = lngStatus
  573.         .strFunction = "CommFlush"
  574.         .strErrorMessage = Err.Description
  575.     End With
  576.     Resume Routine_Exit
  577. End Function
  578.  
  579. '-------------------------------------------------------------------------------
  580. ' CommRead - Read serial port input buffer.
  581. '
  582. ' Parameters:
  583. '   intPortID   - Port ID used when port was opened.
  584. '   strData     - Data buffer.
  585. '   lngSize     - Maximum number of bytes to be read.
  586. '
  587. ' Returns:
  588. '   Error Code  - 0 = No Error.
  589. '-------------------------------------------------------------------------------
  590. Public Function CommRead(intPortID As Integer, strdata As String, _
  591.     lngSize As Long) As Long
  592.  
  593. Dim lngStatus As Long
  594. Dim lngRdSize As Long, lngBytesRead As Long
  595. Dim lngRdStatus As Long, strRdBuffer As String * 1024
  596. Dim lngErrorFlags As Long, udtCommStat As COMSTAT
  597.  
  598.     On Error GoTo Routine_Error
  599.  
  600.     strdata = ""
  601.     lngBytesRead = 0
  602.     DoEvents
  603.  
  604.     ' Clear any previous errors and get current status.
  605.     lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
  606.         udtCommStat)
  607.  
  608.     If lngStatus = 0 Then
  609.         lngBytesRead = -1
  610.         lngStatus = SetCommError("CommRead (ClearCommError)")
  611.         GoTo Routine_Exit
  612.     End If
  613.  
  614.     If udtCommStat.cbInQue > 0 Then
  615.         If udtCommStat.cbInQue > lngSize Then
  616.             lngRdSize = udtCommStat.cbInQue
  617.         Else
  618.             lngRdSize = lngSize
  619.         End If
  620.     Else
  621.         lngRdSize = 0
  622.     End If
  623.  
  624.     If lngRdSize Then
  625.         lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
  626.             lngRdSize, lngBytesRead, udtCommOverlap)
  627.  
  628.         If lngRdStatus = 0 Then
  629.             lngStatus = GetLastError
  630.             If lngStatus = ERROR_IO_PENDING Then
  631.                 ' Wait for read to complete.
  632.                 ' This function will timeout according to the
  633.                 ' COMMTIMEOUTS.ReadTotalTimeoutConstant variable.
  634.                 ' Every time it times out, check for port errors.
  635.  
  636.                 ' Loop until operation is complete.
  637.                 While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
  638.                     udtCommOverlap, lngBytesRead, True) = 0
  639.  
  640.                     lngStatus = GetLastError
  641.  
  642.                     If lngStatus <> ERROR_IO_INCOMPLETE Then
  643.                         lngBytesRead = -1
  644.                         lngStatus = SetCommErrorEx( _
  645.                             "CommRead (GetOverlappedResult)", _
  646.                             udtPorts(intPortID).lngHandle)
  647.                         GoTo Routine_Exit
  648.                     End If
  649.                 Wend
  650.             Else
  651.                 ' Some other error occurred.
  652.                 lngBytesRead = -1
  653.                 lngStatus = SetCommErrorEx("CommRead (ReadFile)", _
  654.                     udtPorts(intPortID).lngHandle)
  655.                 GoTo Routine_Exit
  656.  
  657.             End If
  658.         End If
  659.  
  660.         strdata = Left$(strRdBuffer, lngBytesRead)
  661.     End If
  662.  
  663. Routine_Exit:
  664.     CommRead = lngBytesRead
  665.     Exit Function
  666.  
  667. Routine_Error:
  668.     lngBytesRead = -1
  669.     lngStatus = Err.Number
  670.     With udtCommError
  671.         .lngErrorCode = lngStatus
  672.         .strFunction = "CommRead"
  673.         .strErrorMessage = Err.Description
  674.     End With
  675.     Resume Routine_Exit
  676. End Function
  677.  
  678. '-------------------------------------------------------------------------------
  679. ' CommWrite - Output data to the serial port.
  680. '
  681. ' Parameters:
  682. '   intPortID   - Port ID used when port was opened.
  683. '   strData     - Data to be transmitted.
  684. '
  685. ' Returns:
  686. '   Error Code  - 0 = No Error.
  687. '-------------------------------------------------------------------------------
  688. Public Function CommWrite(intPortID As Integer, strdata As String) As Long
  689.  
  690. Dim i As Integer
  691. Dim lngStatus As Long, lngSize As Long
  692. Dim lngWrSize As Long, lngWrStatus As Long
  693.  
  694.     On Error GoTo Routine_Error
  695.  
  696.     ' Get the length of the data.
  697.     lngSize = Len(strdata)
  698.  
  699.     ' Output the data.
  700.     lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strdata, lngSize, _
  701.         lngWrSize, udtCommOverlap)
  702.  
  703.     ' Note that normally the following code will not execute because the driver
  704.     ' caches write operations. Small I/O requests (up to several thousand bytes)
  705.     ' will normally be accepted immediately and WriteFile will return true even
  706.     ' though an overlapped operation was specified.
  707.  
  708.     DoEvents
  709.  
  710.     If lngWrStatus = 0 Then
  711.         lngStatus = GetLastError
  712.         If lngStatus = 0 Then
  713.             GoTo Routine_Exit
  714.         ElseIf lngStatus = ERROR_IO_PENDING Then
  715.             ' We should wait for the completion of the write operation so we know
  716.             ' if it worked or not.
  717.             '
  718.             ' This is only one way to do this. It might be beneficial to place the
  719.             ' writing operation in a separate thread so that blocking on completion
  720.             ' will not negatively affect the responsiveness of the UI.
  721.             '
  722.             ' If the write takes long enough to complete, this function will timeout
  723.             ' according to the CommTimeOuts.WriteTotalTimeoutConstant variable.
  724.             ' At that time we can check for errors and then wait some more.
  725.  
  726.             ' Loop until operation is complete.
  727.             While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
  728.                 udtCommOverlap, lngWrSize, True) = 0
  729.  
  730.                 lngStatus = GetLastError
  731.  
  732.                 If lngStatus <> ERROR_IO_INCOMPLETE Then
  733.                     lngStatus = SetCommErrorEx( _
  734.                         "CommWrite (GetOverlappedResult)", _
  735.                         udtPorts(intPortID).lngHandle)
  736.                     GoTo Routine_Exit
  737.                 End If
  738.             Wend
  739.         Else
  740.             ' Some other error occurred.
  741.             lngWrSize = -1
  742.  
  743.             lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _
  744.                 udtPorts(intPortID).lngHandle)
  745.             GoTo Routine_Exit
  746.  
  747.         End If
  748.     End If
  749.  
  750.     For i = 1 To 10
  751.         DoEvents
  752.     Next
  753.  
  754. Routine_Exit:
  755.     CommWrite = lngWrSize
  756.     Exit Function
  757.  
  758. Routine_Error:
  759.     lngStatus = Err.Number
  760.     With udtCommError
  761.         .lngErrorCode = lngStatus
  762.         .strFunction = "CommWrite"
  763.         .strErrorMessage = Err.Description
  764.     End With
  765.     Resume Routine_Exit
  766. End Function
  767.  
  768. '-------------------------------------------------------------------------------
  769. ' CommGetLine - Get the state of selected serial port control lines.
  770. '
  771. ' Parameters:
  772. '   intPortID   - Port ID used when port was opened.
  773. '   intLine     - Serial port line. CTS, DSR, RING, RLSD (CD)
  774. '   blnState    - Returns state of line (Cleared or Set).
  775. '
  776. ' Returns:
  777. '   Error Code  - 0 = No Error.
  778. '-------------------------------------------------------------------------------
  779. Public Function CommGetLine(intPortID As Integer, intLine As Integer, _
  780.    blnState As Boolean) As Long
  781.  
  782. Dim lngStatus As Long
  783. Dim lngComStatus As Long, lngModemStatus As Long
  784.  
  785.     On Error GoTo Routine_Error
  786.  
  787.     lngStatus = GetCommModemStatus(udtPorts(intPortID).lngHandle, lngModemStatus)
  788.  
  789.     If lngStatus = 0 Then
  790.         lngStatus = SetCommError("CommReadCD (GetCommModemStatus)")
  791.         GoTo Routine_Exit
  792.     End If
  793.  
  794.     If (lngModemStatus And intLine) Then
  795.         blnState = True
  796.     Else
  797.         blnState = False
  798.     End If
  799.  
  800.     lngStatus = 0
  801.  
  802. Routine_Exit:
  803.     CommGetLine = lngStatus
  804.     Exit Function
  805.  
  806. Routine_Error:
  807.     lngStatus = Err.Number
  808.     With udtCommError
  809.         .lngErrorCode = lngStatus
  810.         .strFunction = "CommReadCD"
  811.         .strErrorMessage = Err.Description
  812.     End With
  813.     Resume Routine_Exit
  814. End Function
  815.  
  816. '-------------------------------------------------------------------------------
  817. ' CommSetLine - Set the state of selected serial port control lines.
  818. '
  819. ' Parameters:
  820. '   intPortID   - Port ID used when port was opened.
  821. '   intLine     - Serial port line. BREAK, DTR, RTS
  822. '                 Note: BREAK actually sets or clears a "break" condition on
  823. '                 the transmit data line.
  824. '   blnState    - Sets the state of line (Cleared or Set).
  825. '
  826. ' Returns:
  827. '   Error Code  - 0 = No Error.
  828. '-------------------------------------------------------------------------------
  829. Public Function CommSetLine(intPortID As Integer, intLine As Integer, _
  830.    blnState As Boolean) As Long
  831.  
  832. Dim lngStatus As Long
  833. Dim lngNewState As Long
  834.  
  835.     On Error GoTo Routine_Error
  836.  
  837.     If intLine = LINE_BREAK Then
  838.         If blnState Then
  839.             lngNewState = SETBREAK
  840.         Else
  841.             lngNewState = CLRBREAK
  842.         End If
  843.  
  844.     ElseIf intLine = LINE_DTR Then
  845.         If blnState Then
  846.             lngNewState = SETDTR
  847.         Else
  848.             lngNewState = CLRDTR
  849.         End If
  850.  
  851.     ElseIf intLine = LINE_RTS Then
  852.         If blnState Then
  853.             lngNewState = SETRTS
  854.         Else
  855.             lngNewState = CLRRTS
  856.         End If
  857.     End If
  858.  
  859.     lngStatus = EscapeCommFunction(udtPorts(intPortID).lngHandle, lngNewState)
  860.  
  861.     If lngStatus = 0 Then
  862.         lngStatus = SetCommError("CommSetLine (EscapeCommFunction)")
  863.         GoTo Routine_Exit
  864.     End If
  865.  
  866.     lngStatus = 0
  867.  
  868. Routine_Exit:
  869.     CommSetLine = lngStatus
  870.     Exit Function
  871.  
  872. Routine_Error:
  873.     lngStatus = Err.Number
  874.     With udtCommError
  875.         .lngErrorCode = lngStatus
  876.         .strFunction = "CommSetLine"
  877.         .strErrorMessage = Err.Description
  878.     End With
  879.     Resume Routine_Exit
  880. End Function
  881.  
  882. '-------------------------------------------------------------------------------
  883. ' CommGetError - Get the last serial port error message.
  884. '
  885. ' Parameters:
  886. '   strMessage  - Error message from last serial port error.
  887. '
  888. ' Returns:
  889. '   Error Code  - Last serial port error code.
  890. '-------------------------------------------------------------------------------
  891. Public Function CommGetError(strMessage As String) As Long
  892.  
  893.     With udtCommError
  894.         CommGetError = .lngErrorCode
  895.         strMessage = "Error (" & CStr(.lngErrorCode) & "): " & .strFunction & _
  896.             " - " & .strErrorMessage
  897.     End With
  898.  
  899. End Function
  900.  
  901.  
  902.  
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.
Apr 15 '15 #6

100+
P: 462
I was able to get this to work. I had to send as a byte to the machine so this is what I sent
Expand|Select|Wrap|Line Numbers
  1.     VchkSum = 200 + 30 + CmbBedDesc + VTimeused + Vmode + VbedDel
  2.     strdata = Chr(200) + Chr(30) + Chr(CmbBedDesc) + Chr(VTimeused) + Chr(Vmode) + Chr(VbedDel) + Chr(0) + Chr(VchkSum)
  3.  
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
Expand|Select|Wrap|Line Numbers
  1. Dim rxarray() as byte
  2.  
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
Expand|Select|Wrap|Line Numbers
  1. rxarray = strdata
. 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
May 2 '15 #7

jforbes
Expert 100+
P: 1,107
This might work for you:
Expand|Select|Wrap|Line Numbers
  1. Dim sString AS String
  2. sString = StrConv(rxarray, vbProperCase)
May 4 '15 #8

100+
P: 462
I'll give that a try and let you know. Thanks
May 4 '15 #9

100+
P: 462
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.
May 13 '15 #10

jforbes
Expert 100+
P: 1,107
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:
Expand|Select|Wrap|Line Numbers
  1. ?ubound(rxarray)
  2. ?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:
Expand|Select|Wrap|Line Numbers
  1. Dim iCount As Integer
  2. For iCount  = LBound(rxarray) To UBound(rxarray)-1
  3.     Debug.Print rxarray(iCount)
  4. 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.
May 14 '15 #11

NeoPa
Expert Mod 15k+
P: 31,769
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 :
Expand|Select|Wrap|Line Numbers
  1. Private Sub StringToByte(ByRef abytVar() As Byte, ByVal strVar as String)
  2.     Dim lngVar As Long
  3.  
  4.     ReDim abytVar(0 To Len(strVar) - 1)
  5.     For lngVar = 1 To Len(strVar)
  6.         abytVar(lngVar - 1) = Asc(Mid(strVar, lngVar))
  7.     Next lngVar
  8. End Sub
Moving a Byte array into a string can be done with code similar to :
Expand|Select|Wrap|Line Numbers
  1. Private Function ByteToString(ByRef abytVar() As Byte) as String
  2.     Dim lngVar As Long
  3.  
  4.     For lngVar = LBound(abytVar) To UBound(abytVar)
  5.         ByteToString = ByteToString & Chr(abytVar(lngVar))
  6.     Next lngVar
  7. End Sub
May 14 '15 #12

Post your reply

Sign in to post your reply or Sign up for a free account.