/
test.prg
99 lines (74 loc) · 1.83 KB
/
test.prg
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
/*
* 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