Nelmarcas
asked on
Accessing Com Port data string
Can anyone help me write an event procedure that grabs a data string from a com port and places it into an access table. This procedure needs to do loop back and repeat the procedure every 15 seconds and store all the data in a table. Is this possible? help...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Nelmarcas,
Can you e-mail me the functions? I will try to straight it out for you. My email: Dalin_N@MailExcite.com.
Regards
Dalin
Can you e-mail me the functions? I will try to straight it out for you. My email: Dalin_N@MailExcite.com.
Regards
Dalin
Nelmarcas,
I have these code in my Bank I had for sometime. This uses API calls. I believe it worked in Access 2.0 but have not tries in Access 95/97. See if you can use it. Let me know if you have any questions.
Regards
Dalin
Global i_ComErr As Integer
Global i_hComm As Integer ' COMM - handle
Dim l_TicksPerSecAs Long
' The following type needed only for passing to the coml_Bui
' ldCommDCB()
and
' ' coml_SetCommState() functions
Type coml_TDCB ' device control block
Id As String * 1
BaudRate As Integer
ByreSize As String * 1
Parity As String * 1
StopBits As String * 1
RlsTimeOut As Integer
CtsTimeout As Integer
Flags As Integer
XonChar As String * 1
XoffChar As String * 1
XonLim As Integer
XoffLim As Integer
PeChar As String * 1
EofChar As String * 1
EvtChar As String * 1
TxDelay As Integer
End Type
Type coml_TCOMSTAT
status As String * 1'specifies status of the transmission
cbInQue As Integer 'number of characters in the receive queue
cbOutQue As Integer 'number of characyers in the transmit queue
End Type
Type coml_TDIALINFO
szPhone As String'phone number
szPrefix As String 'prefix
fUsePrefix As Integer'True / False flag
eBaudRate As Integer'Baud rate : control panel settings
eDialType As Integer'Pulse or Tone : control panel settings
eCom As Integer 'port settings (control panel)
szDevice As String 'what is passed to the OpenComm (COM1, COM2,
..)
idCommDev As Integer'communication device identifier
End Type
Declare Function coml_ReadComm Lib "User" Alias "ReadComm" (ByVal nCid
As Integer, ByVal lpBuf As String, ByVal nRequested As Integer) As
Integer
Declare Function coml_OpenComm Lib "User" Alias "#200" (ByVal lpComName
As String, ByVal wInQueue As Integer, ByVal wOutQueue As Integer) As
Integer
Declare Function coml_WriteComm Lib "User" Alias "#205" (ByVal nCid As
Integer, ByVal lpBuf As String, ByVal nSize As Integer) As Integer
Declare Function coml_CloseComm Lib "User" Alias "#207" (ByVal nCid As
Integer) As Integer
Declare Function coml_FlushComm Lib "User" Alias "#215" (ByVal nCid As
Integer, ByVal nQueue As Integer) As Integer
Declare Function coml_GetCommState Lib "User" Alias "#202" (ByVal
idComDev As Integer, lpDCB As coml_TDCB) As Integer
Declare Function coml_SetCommState Lib "User" Alias "#201" (lpDCB As
coml_TDCB) As Integer
Declare Function coml_GetCommError Lib "User" Alias "#203" (ByVal
idComDev As Integer, lpStat As coml_TCOMSTAT) As Integer
Declare Function coml_BuildCommDCB Lib "User" Alias "#213" (ByVal
szPortInfo As String, lpDCB As coml_TDCB) As Integer
Declare Function coml_fGetTickCount Lib "User" Alias "#13" () As Long
' Close the serial channel. Do not forget to close it, becau
' se all
attempts to open it again
' ' will fail if it isn't closed.
' '
Sub COM_Close ()
Dim res As Integer
res = coml_CloseComm(i_hComm)
End Sub
' ' Returns the status code of the previous function or sub.
' '
' ' 0 = OK
' '
Function COM_Error () As Integer
COM_Error = i_ComErr
End Function
' '
' ' Flush the queue buffers of windows
' '
' ' iWas: 0=transmission queue, 1=receive queue
' '
Sub COM_Flush (ByVal iWas%)
Dim res%
res = coml_FlushComm(i_hComm, iWas)
End Sub
' ' Open a serial port.
' '
' szPortInfo specifies the port, baud rate and other setting
' s.
' 'Example: COM1:9600,n,8,1
' ' The format of the string is as for the DOS MODE command.
' '
' In case of errors a messagebox will be displayed and COM_E
' rror
' ' returns a value <> 0.
' '
' Do not forget to call COM_Close at the end of the program
' !
' '
Sub COM_Open (ByVal szPortInf As String)
Static DCB As coml_TDCB
Dim ComStatInfo As coml_TCOMSTAT
Dim pos As Integer
Dim res As Integer
Dim szComm As String
Static szPortInfo As String * 30
' Size in bytes of the input and output queue. Adapt if nece
' ssary.
Const CB_INQUEUE = 256
Const CB_OUTQUEUE = 256
szPortInfo = szPortInf
pos = InStr(szPortInfo, ":")
If pos < 1 Then
MsgBox "COMx: not specified.", 48, "COM_Open Error (" &
szPortInfo & ")"
i_ComErr = 1001
Exit Sub
End If
szComm = Left$(szPortInfo, pos - 1)
i_hComm = coml_OpenComm(szComm, CB_INQUEUE, CB_OUTQUEUE)
If i_hComm < 0 Then
MsgBox "COM-Port cannot be opened.", 48, "COM_Open Error (" &
szPortInfo & ")"
i_ComErr = 1002
Exit Sub
End If
res = 0
If Not coml_BuildCommDCB(szPortIn fo, DCB) Then
res = coml_SetCommState(DCB)
Else
res = coml_GetCommError(i_hComm, ComStatInfo)
End If
If res < 0 Then
MsgBox "Cannot set baud rate of COM port.", 48, "COM_Open Error
(" & szPortInfo & ")"
i_ComErr = 1003
Exit Sub
End If
i_ComErr = 0
End Sub
' Read serial port, wait until requested amount of bytes is
' available in
the input buffer.
' '
' iRequestedCnt Number of bytes to read. If less bytes are r
' eceived
within the timeout,
' 'COM_ReadWait returns an empty string and COM_Error
returns 3001.
' '
' ' iTimeout Timeout in seconds. The function waits for the
specified time
' 'if less than iRequestedCnt bytes are in the input
buffer.
' '
' ' Return:Text string with received data. Can contain
0-characters.
' '
Function COM_ReadWait (ByVal iRequestedCnt As Integer, ByVal iTimeout As
Integer)
Dim res As Integer
Dim ComStatInfo As coml_TCOMSTAT
Dim t
Dim szBufAs String
szBuf = String$(iRequestedCnt + 1, 0)
t = Timer
Do
DoEvents
res = coml_GetCommError(i_hComm, ComStatInfo)
If iTimeout > 0 Then
If Timer > t + iTimeout Then
szBuf = ""
i_ComErr = 3001
COM_ReadWait = ""
Exit Function
End If
End If
Loop Until ComStatInfo.cbInQue >= iRequestedCnt
res = coml_ReadComm(i_hComm, szBuf, iRequestedCnt)
If res <> iRequestedCnt Then
MsgBox "Error receiving data.", 48, "COM_ReadWait Error "
i_ComErr = 3002
COM_ReadWait = ""
End If
i_ComErr = 0
COM_ReadWait = szBuf
End Function
' ' Write data to serial port.
' '
' ' szBuf String buffer containing data
' '
Sub COM_Write (ByVal szBuf As String)
Dim res As Integer
Dim ComStatInfo As coml_TCOMSTAT
Dim szBufferAs String
Dim StartTimeAs Long
Dim t
Dim iBuflen As Integer
iBuflen = Len(szBuf)
t = Timer
Do While True
If coml_WriteComm(i_hComm, szBuf, iBuflen) > 0 Then Exit Do
res = coml_GetCommError(i_hComm, ComStatInfo)
res = coml_FlushComm(i_hComm, 0)
If Timer > t + 10 Then
MsgBox "Timeout on WriteComm (Write).", 48, "COM_Write Error
(" & szBuf & ")"
i_ComErr = 2001
Exit Sub
End If
Loop
StartTime = coml_fGetTickCount()
Do While True
res = coml_GetCommError(i_hComm, ComStatInfo)
If ComStatInfo.cbOutQue = 0 Then Exit Do
If (coml_fGetTickCount() - StartTime) > 30000 Then
MsgBox "Timeout on WriteComm (Status).", 48, "COM_Write
Error (" & szBuf & ")"
i_ComErr = 2002
Exit Sub
End If
Loop
res = coml_FlushComm(i_hComm, 0)
i_ComErr = 0
End Sub
I have these code in my Bank I had for sometime. This uses API calls. I believe it worked in Access 2.0 but have not tries in Access 95/97. See if you can use it. Let me know if you have any questions.
Regards
Dalin
Global i_ComErr As Integer
Global i_hComm As Integer ' COMM - handle
Dim l_TicksPerSecAs Long
' The following type needed only for passing to the coml_Bui
' ldCommDCB()
and
' ' coml_SetCommState() functions
Type coml_TDCB ' device control block
Id As String * 1
BaudRate As Integer
ByreSize As String * 1
Parity As String * 1
StopBits As String * 1
RlsTimeOut As Integer
CtsTimeout As Integer
Flags As Integer
XonChar As String * 1
XoffChar As String * 1
XonLim As Integer
XoffLim As Integer
PeChar As String * 1
EofChar As String * 1
EvtChar As String * 1
TxDelay As Integer
End Type
Type coml_TCOMSTAT
status As String * 1'specifies status of the transmission
cbInQue As Integer 'number of characters in the receive queue
cbOutQue As Integer 'number of characyers in the transmit queue
End Type
Type coml_TDIALINFO
szPhone As String'phone number
szPrefix As String 'prefix
fUsePrefix As Integer'True / False flag
eBaudRate As Integer'Baud rate : control panel settings
eDialType As Integer'Pulse or Tone : control panel settings
eCom As Integer 'port settings (control panel)
szDevice As String 'what is passed to the OpenComm (COM1, COM2,
..)
idCommDev As Integer'communication device identifier
End Type
Declare Function coml_ReadComm Lib "User" Alias "ReadComm" (ByVal nCid
As Integer, ByVal lpBuf As String, ByVal nRequested As Integer) As
Integer
Declare Function coml_OpenComm Lib "User" Alias "#200" (ByVal lpComName
As String, ByVal wInQueue As Integer, ByVal wOutQueue As Integer) As
Integer
Declare Function coml_WriteComm Lib "User" Alias "#205" (ByVal nCid As
Integer, ByVal lpBuf As String, ByVal nSize As Integer) As Integer
Declare Function coml_CloseComm Lib "User" Alias "#207" (ByVal nCid As
Integer) As Integer
Declare Function coml_FlushComm Lib "User" Alias "#215" (ByVal nCid As
Integer, ByVal nQueue As Integer) As Integer
Declare Function coml_GetCommState Lib "User" Alias "#202" (ByVal
idComDev As Integer, lpDCB As coml_TDCB) As Integer
Declare Function coml_SetCommState Lib "User" Alias "#201" (lpDCB As
coml_TDCB) As Integer
Declare Function coml_GetCommError Lib "User" Alias "#203" (ByVal
idComDev As Integer, lpStat As coml_TCOMSTAT) As Integer
Declare Function coml_BuildCommDCB Lib "User" Alias "#213" (ByVal
szPortInfo As String, lpDCB As coml_TDCB) As Integer
Declare Function coml_fGetTickCount Lib "User" Alias "#13" () As Long
' Close the serial channel. Do not forget to close it, becau
' se all
attempts to open it again
' ' will fail if it isn't closed.
' '
Sub COM_Close ()
Dim res As Integer
res = coml_CloseComm(i_hComm)
End Sub
' ' Returns the status code of the previous function or sub.
' '
' ' 0 = OK
' '
Function COM_Error () As Integer
COM_Error = i_ComErr
End Function
' '
' ' Flush the queue buffers of windows
' '
' ' iWas: 0=transmission queue, 1=receive queue
' '
Sub COM_Flush (ByVal iWas%)
Dim res%
res = coml_FlushComm(i_hComm, iWas)
End Sub
' ' Open a serial port.
' '
' szPortInfo specifies the port, baud rate and other setting
' s.
' 'Example: COM1:9600,n,8,1
' ' The format of the string is as for the DOS MODE command.
' '
' In case of errors a messagebox will be displayed and COM_E
' rror
' ' returns a value <> 0.
' '
' Do not forget to call COM_Close at the end of the program
' !
' '
Sub COM_Open (ByVal szPortInf As String)
Static DCB As coml_TDCB
Dim ComStatInfo As coml_TCOMSTAT
Dim pos As Integer
Dim res As Integer
Dim szComm As String
Static szPortInfo As String * 30
' Size in bytes of the input and output queue. Adapt if nece
' ssary.
Const CB_INQUEUE = 256
Const CB_OUTQUEUE = 256
szPortInfo = szPortInf
pos = InStr(szPortInfo, ":")
If pos < 1 Then
MsgBox "COMx: not specified.", 48, "COM_Open Error (" &
szPortInfo & ")"
i_ComErr = 1001
Exit Sub
End If
szComm = Left$(szPortInfo, pos - 1)
i_hComm = coml_OpenComm(szComm, CB_INQUEUE, CB_OUTQUEUE)
If i_hComm < 0 Then
MsgBox "COM-Port cannot be opened.", 48, "COM_Open Error (" &
szPortInfo & ")"
i_ComErr = 1002
Exit Sub
End If
res = 0
If Not coml_BuildCommDCB(szPortIn
res = coml_SetCommState(DCB)
Else
res = coml_GetCommError(i_hComm,
End If
If res < 0 Then
MsgBox "Cannot set baud rate of COM port.", 48, "COM_Open Error
(" & szPortInfo & ")"
i_ComErr = 1003
Exit Sub
End If
i_ComErr = 0
End Sub
' Read serial port, wait until requested amount of bytes is
' available in
the input buffer.
' '
' iRequestedCnt Number of bytes to read. If less bytes are r
' eceived
within the timeout,
' 'COM_ReadWait returns an empty string and COM_Error
returns 3001.
' '
' ' iTimeout Timeout in seconds. The function waits for the
specified time
' 'if less than iRequestedCnt bytes are in the input
buffer.
' '
' ' Return:Text string with received data. Can contain
0-characters.
' '
Function COM_ReadWait (ByVal iRequestedCnt As Integer, ByVal iTimeout As
Integer)
Dim res As Integer
Dim ComStatInfo As coml_TCOMSTAT
Dim t
Dim szBufAs String
szBuf = String$(iRequestedCnt + 1, 0)
t = Timer
Do
DoEvents
res = coml_GetCommError(i_hComm,
If iTimeout > 0 Then
If Timer > t + iTimeout Then
szBuf = ""
i_ComErr = 3001
COM_ReadWait = ""
Exit Function
End If
End If
Loop Until ComStatInfo.cbInQue >= iRequestedCnt
res = coml_ReadComm(i_hComm, szBuf, iRequestedCnt)
If res <> iRequestedCnt Then
MsgBox "Error receiving data.", 48, "COM_ReadWait Error "
i_ComErr = 3002
COM_ReadWait = ""
End If
i_ComErr = 0
COM_ReadWait = szBuf
End Function
' ' Write data to serial port.
' '
' ' szBuf String buffer containing data
' '
Sub COM_Write (ByVal szBuf As String)
Dim res As Integer
Dim ComStatInfo As coml_TCOMSTAT
Dim szBufferAs String
Dim StartTimeAs Long
Dim t
Dim iBuflen As Integer
iBuflen = Len(szBuf)
t = Timer
Do While True
If coml_WriteComm(i_hComm, szBuf, iBuflen) > 0 Then Exit Do
res = coml_GetCommError(i_hComm,
res = coml_FlushComm(i_hComm, 0)
If Timer > t + 10 Then
MsgBox "Timeout on WriteComm (Write).", 48, "COM_Write Error
(" & szBuf & ")"
i_ComErr = 2001
Exit Sub
End If
Loop
StartTime = coml_fGetTickCount()
Do While True
res = coml_GetCommError(i_hComm,
If ComStatInfo.cbOutQue = 0 Then Exit Do
If (coml_fGetTickCount() - StartTime) > 30000 Then
MsgBox "Timeout on WriteComm (Status).", 48, "COM_Write
Error (" & szBuf & ")"
i_ComErr = 2002
Exit Sub
End If
Loop
res = coml_FlushComm(i_hComm, 0)
i_ComErr = 0
End Sub
ASKER
That's great for a from in VIsual Basic. How about a from in Access?
ASKER
oops sorry, I didn't see the comment history.. I'll let you know how i do.. Thanks a bunch
ASKER
I failed to mention that I wanted to use this with a form in Access 97. There is a timer property I can use to set to 15000 without writing any code. I downloaded the wsc32.dll and created a module that listed all the functions for the serial port. This is getting a lot more complicated for me. I can determine what in the data string I can use to place in a table, but no luck on viewing or importing that string that comes across. Any suggestions would be greatly appreciated...