Esta clase la llevo usando años tal cual está sin problemas. Ahora cuando he actualizado las versiones de FW y xHarbour es cuando me da problemas.
/*
TCOMCLASS.prg
21/01/2008
Simple clase para manejo de los puertos serie.
Para incluirla en nuestro programa basta con poner despues de la función main de nuestro programa:
#include 'TCOMCLASS.prg'
y añadir la libreria hbcomm.lib
Ultima Actualización: 07/08/2012
*/
#include "fivewin.ch"
// Valores de comandos para comunicaciones por puerto serie.
#define STX chr(2) //0x02
#define ETX chr(3) //0x03
#define EOT chr(4) //0x04
#define ENQ chr(5) //0x05
#define ACK chr(6) //0x06
#define NAK chr(21) //0x15
#define NACK chr(21) //0x05
#define SOH chr(1) //0x01
#define ETB chr(23) //0x17
CLASS TComClass
DATA cCom // ej: COM1, COM2,...
DATA nComm // Manejador del puerto COM
DATA nBufferEntrada
DATA nBufferSalida
DATA nError
METHOD new(nPuerto,nBaudios,nBits,cParidad,nStops,nBufferSalida,nBufferEntrada) CONSTRUCTOR
METHOD End()
METHOD COM_EscribePuerto(cTexto)
METHOD COM_LimpiaBuffer()
METHOD COM_LeePuerto(nLong)
METHOD COM_LeePuerto_nChars(nChars)
METHOD COM_LeePuertoHastaChrmasBcc(cChar)
METHOD COM_nCharsEnInBuffer()
METHOD COM_nCharsEnOutBuffer()
/*
METHOD Escape( nCode ) BLOCK { |Self,nCode| IIF( EscapeCommFunction( ::nId, nCode ) < 0, ;
MsgInfo( OemToAnsi( "Error enviando c¢digo de escape" ) ), ) }
METHOD Flush( nQueue ) BLOCK { |Self,nQueue| IIF( FlushComm( ::nId, nQueue ) != 0, ;
MsgInfo( "Error al vaciar el buffer de las comunicaciones" ), ) }
METHOD UnBreak() BLOCK { |Self| IIF( ClearCommBreak( ::nId ) < 0, ;
MsgInfo( "Error desbloqueando el puerto de comunicaciones" ), ) }
METHOD Break() BLOCK { |Self| IIF( SetCommBreak( ::nId ) < 0, ;
MsgInfo( "Error al bloquear el puerto de comunicaciones" ), ) }
*/
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New(nPuerto,nBaudios,nParidad,nBits,nStops,nBufferSalida,nBufferEntrada) class TComClass
default nPuerto := 1
default nBaudios:= 9600
default nParidad:= 0 // 0,1,2,3 -> none, odd, mark, even
default nBits := 8
default nStops := 1 // 0,1,2 -> 1, 1.5 , 2
default nBufferSalida :=1024
default nBufferEntrada:=1024
::cCom :='COM'+alltrim(str(nPuerto)) //AS STRING
::nBufferEntrada := nBufferEntrada
::nBufferSalida := nBufferSalida
::nError :=0
//msgwait("Abriendo puerto: "+::cCom,::cCom,1)
::nComm := init_Port( ::cCom, nBaudios,nBits,nParidad,nStops, nBufferEntrada )
if ::nComm > 0
if !ISWORKING(::nComm)
msgstop( "Puerto "+::cCom+' desconectado', ;
"Error intentando abrir puerto serie" )
return( .F. )
endif
::COM_LimpiaBuffer()
endif
return NIL
//----------------------------------------------------------------------------//
METHOD End() class TComClass
//Close_Port( ::nComm )
UNint_Port()
return NIL
//----------------------------------------------------------------------------//
METHOD COM_EscribePuerto(cTexto) class TComClass
local lResult := .t.
local nRetardo := 1 //Segundos
local nIntentos:= 3, ii:=1
local nBytes
default cTexto :=time()+" PRUEBA DE ESCRITURA EN EL PUERTO "+::cCom+ Chr(13)
OutChr( ::nComm, cTexto, len(cTexto) )
/*
for ii:=1 TO nIntentos
if !OutChr( ::nComm, cTexto, len(cTexto) )
//MsgInfo( ::cCom+", Error de escritura " , "ERROR "+::cCom )
lResult:=.f.
RetardoSecs(nRetardo)
else
// Windows requires to have a Window at least to perform comunications !!!
// Let's use the MessageBox() Window as default
// MsgInfo( Str( nBytes ) + " bytes sent" ) //Probado a mi no me ha hecho falta
lResult:=.t.
exit
endif
next ii
*/
return lResult
//----------------------------------------------------------------------------//
METHOD COM_LimpiaBuffer() class TComClass
local lResult:=.t.
OutBufClr( ::nComm )
return lResult
//----------------------------------------------------------------------------//
//Recoge del puerto COM todos los caracteres presentes en el buffer de entrada.
METHOD COM_LeePuerto() class TComClass
local cBuffer:=space(1)
local nBytes :=0
// Get a chunk from the COM port. El tamaño de la loncha (chunk) es el del buffer.
nBytes=InBufSize(::nComm)
cBuffer:=space(nBytes)
if nBytes != InChr( ::nComm, @cBuffer, nBytes )
// MsgStop( 'Some kind of read failure on COM Port.'+::cComm )
endif
return (cBuffer)
//----------------------------------------------------------------------------//
//Recoge del puerto COM nChars caracteres
METHOD COM_LeePuerto_nChars(nChars) class TComClass
local cBuffer:=space(1)
local nBytes := 0
cBuffer:=space(nChars)
nBytes:=nChars
if nBytes != InChr( ::nComm, @cBuffer, nChars )
//MsgStop( 'Some kind of read failure on COM Port.'+::cComm )
endif
return (cBuffer)
//----------------------------------------------------------------------------//
/*Recoge del puerto COM todos los caracteres hasta encontrar el cChar y el siguiente
que contiene el código BCC ó LRC del mensaje.
Se implementa para poder leer el puerto hasta encontrar una marca,
normalmente ETX, y no recoger caracteres siguientes que pueden formar
parte de otro msg.
Si el primer caracter es EOT sale sin leer más.
*/
METHOD COM_LeePuertoHastaChrmasBcc(cChar) class TComClass
local cBuffer:=space(::nBufferEntrada) //Necesario para reservar memoria para la cadena cBuffer
local cCarAct:=space(1)
local nBytes := 0, nChars:=1, nLeidos:=0
default cChar:=ETX
cBuffer:=alltrim(cBuffer) //Necesario para dejar la cadena cBuffer vacía.
while ( cCarAct<>cChar .and. nLeidos <= ::nBufferEntrada )
// Lee el caracter siguiente
if nBytes != InChr( ::nComm, @cCarAct, nChars )
//MsgStop( 'Some kind of read failure on COM Port.'+::cComm )
else
nLeidos:=nLeidos+1
endif
if cCarAct == EOT
return (cCarAct)
else
cBuffer:=cBuffer + cCarAct
endif
enddo
// Recoge ahora el caracter siguiente a cChar que es el correspondiente al BCC
if nBytes != InChr( ::nComm, @cCarAct, nChars )
//MsgStop( 'Some kind of read failure on COM Port.'+::cComm )
endif
cBuffer:=cBuffer + cCarAct
//msginfo("Leido del puerto:"+cBuffer,"COM_LeePuertoHastaChrmasBcc(cChar)")
return (cBuffer)
//----------------------------------------------------------------------------//
// Devuelve los caracteres presentes en el Buffer de Entrada
METHOD COM_nCharsEnInBuffer() class TComClass
return ( InBufSize( ::nComm ) )
//----------------------------------------------------------------------------//
// Devuelve los caracteres presentes en el Buffer de Salida
METHOD COM_nCharsEnOutBuffer() class TComClass
return ( OutBufSize( ::nComm ) )
//----------------------------------------------------------------------------//
