Sample Code that reads com port

[cdmmaui]

Hello Everyone,

Its been a long time! Hope everyone is doing well. By any chance, does someone have a sample code to read a com port. We need to be able to read BT data via com port.

Thank you in advance for your help!

Sincerely,

[Antonio Linares]

Dear Darrell,

https://github.com/harbour/core/blob/master/contrib/hbcomm/tests/test.prg

[cdmmaui]

Thank you Antonio! Hope you are well!

By any chance, is there a FW version available?

[Antonio Linares]

Yes, we are fine thanks God. Wishing you are all fine too.

You may review FWH\samples\testcomm.prg

but it seems to me as Harbour's contribs hbcomm is more complete

[Marc Venken]

Here also some codes related to reading com:
Maybe you can find a usefull snipped...

Code: Select all  Expand view

MENUITEM "DrawerOpen"  ACTION Drawer('Open Drawer','COM1',4800,chr(27)+chr(112)+chr(0)+chr(7)+chr(35),'','')
MENUITEM "CommTest" ACTION Serial('Open Drawer','COM4',4800,chr(27)+chr(112)+chr(0)+chr(7)+chr(35),'','')
MENUITEM "FReadData"  ACTION Freaddata()


///

function Drawer(x0,x1,x2,x3,x4,x5)
   local cDcb, nBytes
   local nComm := OpenComm( alltrim(x1),x2, 128 )
   local nError

   if empty(x1) .or. alltrim(x1)='-' .or. alltrim(x1)='SCREEN'
     return .t.
   endif

   if upper(left(x1,3))='LPT'
     BuildCommDcb( alltrim(x1)+":"+str(x2,4)+",n,8,1", @cDcb )
     SetCommState( cDcb )
     cNxLine=CRLF
   else
     if alltrim(x1)<>'SCREEN'
       x3=padl(left(x3,20),20,' ')
       x4=padl(left(x4,20),20,' ')
     endif
     cNxLine=CHR(13)
    if ! BuildCommDcb( alltrim(x1)+":"+str(x2,4)+",n,8,1", @cDcb )
      nError = GetCommError( nComm )
      Msgwait( x0+" : BuildCommDcb Error: " + Str( nError ),'',.3 )
    endif

    if ! SetCommState( cDcb )
      nError = GetCommError( nComm )
      Msgwait( "SetCommState Error: " + Str( nError ),'',.3 )
      return .t.
    endif
   endif

   if !empty(x5)
     for iii=1 to len(x5)
       if ( nBytes := WriteComm( nComm, x5[iii]) ) < 0
         nError = GetCommError( nComm )
         Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
       else
         Msgwait( x0+' : Ok','',.1 )
       endif
     next
   else
     if ( nBytes := WriteComm( nComm, x3+cNxLine ) ) < 0
       nError = GetCommError( nComm )
       Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
     else
       Msgwait( x0+' : Ok','',.1 )   // important, do not change the delay
     endif
     if !empty(x4)
       if ( nBytes := WriteComm( nComm, x4+cNxLine ) ) < 0
         nError = GetCommError( nComm )
         Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
       else
         Msgwait( x0+' : Ok','',.1 )
       endif
     endif
   endif

   if FlushComm( nComm, 0 ) != 0
      nError = GetCommError( nComm )
      Msgwait( x0+" : FlushComm Error: " + Str( nError ),'',.01 )
   endif

   if ! CloseComm( nComm )
      nError = GetCommError( nComm )
      Msgwait( "CloseComm Error: " + Str( nError ),'',.01 )
   endif

return nil

///

function fReadData
local cDcb, lError, nError

cPort  :='COM1'
gcPort := val(right(cPort,1))
cRate  := '2400'    // baud rate
cErrCode := space( 16 )

   if !( gnComm := OpenComm( cPort, 1024, 10 ) ) == 0

      if !BuildCommDcb( cPort+":"+cRate+",N,8,1", @cDcb )
         nError := GetCommError( gnComm, @cErrCode )

         MsgAlert( "Error "+ str( nError ) + CRLF + cErrCode, "Build error " )
         RETURN( .f. )
      endif

      if !SetCommState( @cDcb )
         nError := GetCommError( gnComm, @cErrCode )
         MsgAlert( "Error "+ str( nError ) + CRLF + cErrCode, "Set Comm error " )
         RETURN( .f. )
      endif
   endif
   cBlock=space(1024)
   nTry=0
   do while nTry<500
     if ( nBytes := readComm( gnComm, @cBlock) ) > 0
       msgwait('Reading ... '+str(nTry,5),'',1)
       exit
     else
       nTry++
       msgwait(str(nTry,5),'',1)
     endif
   enddo
   msgstop(substr(alltrim(cblock),5,10),'Data Read')

   if FlushComm( gnComm, 0 ) != 0
      nError = GetCommError( gnComm )
      Msgwait( 'FlushComm Error:' ,'',.01 )
   endif

   if ! CloseComm( gnComm )
      nError = GetCommError( gnComm )
      Msgwait( 'CloseComm Error: ' ,'',.01 )
   endif

RETURN( .t. )

STATIC FUNCTION Stay( nMilliSeK )
LOCAL nTime := timercount()[ 1 ]

   do while ( timercount()[ 1 ] - nTime ) < nMilliSek
   enddo
RETURN( NIL )


function Serial(x0,x1,x2,x3,x4,x5)
   local cDcb, nBytes
   local nComm := OpenComm( alltrim(x1),x2, 128 )
   local nError

   x3=padl(left(x3,20),20,' ')
   x4=padl(left(x4,20),20,' ')
   cNxLine=CHR(13)
   if ! BuildCommDcb( alltrim(x1)+":"+str(x2,4)+",n,8,1", @cDcb )
     nError = GetCommError( nComm )
     Msgwait( x0+" : BuildCommDcb Error: " + Str( nError ),'',.3 )
   endif
   if ! SetCommState( cDcb )
     nError = GetCommError( nComm )
     Msgwait( "SetCommState Error: " + Str( nError ),'',.3 )
     return .t.
   endif

   if !empty(x5)
     for iii=1 to len(x5)
       if ( nBytes := WriteComm( nComm, x5[iii]) ) < 0
         nError = GetCommError( nComm )
         Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
       else
         Msgwait( x0+' : Ok','',.1 )
       endif
     next
   else
     if ( nBytes := WriteComm( nComm, x3+cNxLine ) ) < 0
       nError = GetCommError( nComm )
       Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
     else
       Msgwait( x0+' : Ok','',.1 )   // important, do not change the delay
     endif
     if !empty(x4)
       if ( nBytes := WriteComm( nComm, x4+cNxLine ) ) < 0
         nError = GetCommError( nComm )
         Msgwait( "WriteComm Error: " + Str( nError ),'',.1 )
       else
         Msgwait( x0+' : Ok','',.1 )
       endif
     endif
   endif

   if FlushComm( nComm, 0 ) != 0
      nError = GetCommError( nComm )
      Msgwait( x0+" : FlushComm Error: " + Str( nError ),'',.01 )
   endif

   if ! CloseComm( nComm )
      nError = GetCommError( nComm )
      Msgwait( "CloseComm Error: " + Str( nError ),'',.01 )
   endif

return nil


 

[cdmmaui]

Thank you