Files
harbour-core/contrib/hbcomm/tests/test.prg
2013-10-09 20:08:24 +02:00

100 lines
1.8 KiB
Plaintext

/*
* Harbour Project source code:
*
* Copyright 2009 Viktor Szakats (vszakats.net/harbour)
* (fixed, adapted to CLI, translated, formatted)
* Copyright 2006 Marcelo Torres <lichitorres@yahoo.com.ar>
* www - http://harbour-project.org
*
*/
#require "hbcomm"
STATIC s_nHandle
STATIC s_lConnected := .F.
PROCEDURE Main()
LOCAL nOption
DO WHILE .T.
? ""
? "Select test:"
? "O) Open"
? "C) Close"
? "S) Send"
? "R) Receive"
? "Q) Quit"
? "> "
nOption := Inkey( 0 )
?? Chr( nOption )
SWITCH Upper( Chr( nOption ) )
CASE "O" ; FConnect() ; EXIT
CASE "C" ; FDisconnect() ; EXIT
CASE "S" ; FSend() ; EXIT
CASE "R" ; FReceive() ; EXIT
CASE "Q" ; RETURN
ENDSWITCH
ENDDO
RETURN
STATIC PROCEDURE FConnect()
LOCAL cCom := "COM1"
LOCAL nBaudeRate := 19200
LOCAL nDatabits := 8
LOCAL nParity := 0 /* none */
LOCAL nStopbit := 1
LOCAL nBuff := 8000
s_nHandle := INIT_PORT( cCom, nBaudeRate, nDatabits, nParity, nStopbit, nBuff )
IF s_nHandle > 0
? "Connecting..."
s_lConnected := .T.
OUTBUFCLR( s_nHandle )
ELSE
? "Could not open connection"
s_lConnected := .F.
ENDIF
RETURN
STATIC PROCEDURE FDisconnect()
s_lConnected := .F.
UNINT_PORT( s_nHandle )
RETURN
STATIC PROCEDURE FSend()
LOCAL cToSend
ACCEPT "Enter string to send: " TO cToSend
IF s_lConnected .AND. ! Empty( cToSend ) .AND. ISWORKING( s_nHandle )
OUTCHR( s_nHandle, cToSend )
ELSE
? "Cannot send data"
ENDIF
RETURN
STATIC PROCEDURE FReceive()
LOCAL cReceive
LOCAL nSize
nSize := INBUFSIZE( s_nHandle )
IF nSize > 0
cReceive := Space( nSize )
INCHR( s_nHandle, nSize, @cReceive )
? ">>", Left( cReceive, nSize )
ENDIF
RETURN