Maybe you can find a usefull snipped...
Code: Select all | Expand
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