FiveTech Software tech support forums

Posted: **Sat Jul 22, 2017 1:10 am**

Estimaodos amigos. un saludito fraternal a los listeros. teng dos preguntas.

1 esta rutina podra sr adatada para ser utilzada en fwh porque creo que fue hecha para algun dispositovo movil
2 De ser asi cual seria la libreria para accesar los puertos OpenCom , ComRead ect. gracias desde ya.

Gracias al señor
///////////////////////////////////////////////////////
// Mini Clase TGps
//
// Lectura de sentencias NMEA GPGGA y GPRMC de un GPS
// son las necesarias para conocer fecha, hora, posición, velocidad
// Probado con GPS bluetooth en Com:8 e IPAQ HP2210
//
// Autor: Salvador Gallardo 2007
//

#include "FiveWin.ch"

Function Main( cCom ) // especifica el puerto como parámetro
LOCAL oWnd, oGps, nCom, oTimer
DEFAULT cCom := "8" // puerto Com:8
nCom := VAL(cCom)

DEFINE WINDOW oWnd TITLE "GPS TEST"

oGps := Tgps():New( oWnd )
oTimer := Ttimer():New( 1000, { || UpdateControls( oWnd, oTimer ) }, oWnd )

@ 5, 5 SAY "Fecha" SIZE 53, 20 RIGHT PIXEL
@ 5, 60 GET oGps:cDate SIZE 80, 20 WHEN .f. PIXEL OF oWnd
@ 5, 145 GET oGps:cTime SIZE 60, 20 WHEN .f. PIXEL OF oWnd

@ 27, 5 SAY "Lat." SIZE 53,20 RIGHT PIXEL
@ 27, 60 GET oGps:cLat SIZE 80,20 WHEN .f. PIXEL OF oWnd
@ 27, 145 GET oGps:cNS SIZE 20,20 WHEN .f. PIXEL OF oWnd

@ 50, 5 SAY "Long." SIZE 53,20 RIGHT PIXEL
@ 50, 60 GET oGps:cLong SIZE 80,20 WHEN .f. PIXEL OF oWnd
@ 50, 145 GET oGps:cEW SIZE 20,20 WHEN .f. PIXEL OF oWnd

@ 72, 5 SAY "Lat dec." SIZE 50,20 RIGHT PIXEL
@ 72, 60 GET oGps:nLat SIZE 80,20 PICTURE "999.999999" RIGHT;
WHEN .f. PIXEL OF oWnd

@ 94, 5 SAY "Lon dec." SIZE 50,20 RIGHT PIXEL
@ 94, 60 GET oGps:nLong SIZE 80,20 PICTURE "999.999999" RIGHT;
WHEN .f. PIXEL OF oWnd

@ 118, 5 SAY "Fix" SIZE 50,20 RIGHT PIXEL
@ 116, 60 GET oGps:cFix SIZE 30,20 WHEN .f. PIXEL OF oWnd

@ 140, 5 SAY "Sats" SIZE 50,20 RIGHT PIXEL
@ 138, 60 GET oGps:cSats SIZE 30,20 WHEN .f. PIXEL OF oWnd

@ 162, 5 SAY "Alt." SIZE 50,20 RIGHT PIXEL
@ 160, 60 GET oGps:cAlt SIZE 60,20 WHEN .f. PIXEL OF oWnd

@ 184, 5 SAY "Veloc." SIZE 50,20 RIGHT PIXEL
@ 182, 60 GET oGps:cSpeed SIZE 60,20 WHEN .f. PIXEL OF oWnd

@ 204, 5 GET oGps:cNMEA SIZE 232,40 WHEN .f. MULTILINE;
NO VSCROLL PIXEL OF oWnd

@ 258, 5 BUTTON "CONECTAR" SIZE 95, 25 PIXEL;
ACTION ( oGps:Conecta( nCom ), oTimer:Activate());

@ 258, 110 BUTTON "DESCONECTAR" SIZE 95, 25 PIXEL;
ACTION ( oTimer:Deactivate(), oGps:Desconecta() )

ACTIVATE WINDOW oWnd;
VALID ( oTimer:End(), oGps:end(), .t.)

RETURN .t.

///////////////////////////////////////////////////////
// Mini Clase TGps
//
// Lectura de sentencias NMEA GPGGA y GPRMC de un GPS
// son las necesarias para conocer fecha, hora, posición, velocidad
// Probado con GPS bluetooth en Com:8 e IPAQ HP2210
//
// Autor: Salvador Gallardo 2007
//
///////////////////////////////////////////////////////

#define LENNMEA 1024 // longitud cadena leida 3 sentencias minimo
#define READINTERVAL 1500 // intervalo de lectura del puerto en ms.
#define NRETRY 10 // reintentos de lectura del puerto
#define BAUDS 4800 // velocidad de recepcion

CLASS TGps

DATA lGps // hay conexion con el gps
DATA oTimer // intervalo de tiempo para leer el puerto
DATA oWnd // ventana asociada los timers estan asociados a una window
DATA aNMEA // array con las sentencias nmea leidas
DATA cNMEA // ultima sentencia interpretada
DATA cTime // hora
DATA cDate // fecha
DATA cLat, cLong // latitud y longitud en formato //dddmm.mmmm,ddddmm.mmmm
DATA cNS, cEW // indicadores de N/S E/O
DATA nLat, nLong // latitud y longitud en formato decimal dd.mmmmmmmm
DATA cFix // fix del gps 0= invalido 1= valido
DATA cSats // satelites usados
DATA cAlt // altitud
DATA cSpeed // velocidad
DATA CMsgErr // guarda estado conexion con gps
DATA nHdlCom // handle del puerto de comunicaciones
DATA nRetry // reintentos sin recibir datos del GPS
DATA lLog // hace log de los datos en una dbf

METHOD New( oWnd ) CONSTRUCTOR
METHOD Conecta( nCom )
METHOD Desconecta( )
METHOD LeeNMEA() // lee datos del gps
METHOD GPGGA( cCad ) // procesa sentencia GPGGA
METHOD GPRMC( cCad ) // procesa sentencia GPRMC
METHOD End()

ENDCLASS

METHOD New( oWnd ) CLASS TGps

::aNMEA := Array(3) // se leen 3 sentencias cada vez
::lGps := .f.
::cMsgErr := "INIT"
::oWnd := oWnd
::nRetry := 0
::oTimer := TTimer():New( READINTERVAL, { || ::LeeNMEA()}, ::oWnd )
::lLog := .f.
::nLat := 0
::nLong := 0
RETURN self

////////////////////////////////////////////////////////////////
METHOD Conecta( nCom ) CLASS TGps

::nHdlCom := OpenCom( nCom, BAUDS )

IF ::nHdlCom < 0
::lGps := .f.
::cMsgErr := "FALLO AL ABRIR EL COM:"+ Str( nCom,2 )
ENDIF
::cMsgErr := "PUERTO ABIERTO"
::oTimer:Activate()
RETURN nil

/////////////////////////////////////////////////////////////////
METHOD DesConecta() CLASS TGps

::oTimer:Deactivate()
ComClose( ::nHdlCom )
::lGps := .f.
::cMsgErr := "DESCONECTADO DEL GPS"

RETURN nil

//////////////////////////////////////////////////////////////////
//
// LeeNMEA()
// Lee el puerto y si hay datos los interpreta
///////////////////////////////////////////////////////////////////
METHOD LeeNMEA() CLASS TGps
LOCAL c, cBuffer

::oTimer:Deactivate()
cBuffer := ComRead( ::nHdlCom, LENNMEA )

IF Len( cBuffer ) <= 0
::nRetry ++
IF::nRetry > NRETRY
::lGps := .f.
::cMsgErr := "PERDIDA CONEXION"
ENDIF
ELSE
::nRetry := 0
FOR c := 1 TO LEN( ::aNMEA )
::aNMEA[c] := StrToken( cBuffer, c, "$" )
NEXT

FOR c := LEN( ::aNMEA ) TO 1 STEP -1 // leemos ultimas sentencias

DO CASE
CASE AT( "GPGGA", ::aNMEA[c] ) ==1
IF ChkSum( ::aNMEA[c] )
::cNMEA := ::aNMEA[c]
::GPGGA( ::aNMEA[c] )
ENDIF
EXIT
CASE AT( "GPRMC", ::aNMEA[c] ) ==1
IF ChkSum( ::aNMEA[c] )
::cNMEA := ::aNMEA[c]
::GPRMC( ::aNMEA[c] )
ENDIF
EXIT
ENDCASE

NEXT

ENDIF

::oTimer:Activate()

RETURN nil

//////////////////////////////////////////////////////////////
//
// GPGGA( cCad )
// Extrae los datos de una sentencia GPGGA
////////////////////////////////////////////////////////////
METHOD GPGGA( cCad ) CLASS TGps
LOCAL cHora, nLat, nLon, nGrados, nMinutos

SET DECIMALS TO 6

cHora := StrToken( cCad, 2, "," )
::cTime := Substr( cHora,1,2)+":"+Substr( cHora,3,2)+":"+Substr( cHora,5,2)
::cLat := StrToken( cCad, 3, "," )
::cNS := StrToken( cCad, 4, "," )
::cLong := StrToken( cCad, 5, "," )
::cEW := StrToken( cCad, 6, "," )
::cFix := StrToken( cCad, 7, "," )
::cSats := StrToken( cCad, 8, "," )
::cAlt := StrToken( cCad, 10, "," )

// calculamos latitud y longitud en decimal
// es la que utiliza Google Maps
nGrados := Val(SubStr( ::cLat, 1, 2) )
nMinutos := Val(SubStr( ::cLat, 3, 7) ) /60
::nLat := nGrados+ nMinutos* IIF( ::cNS ="S", -1, 1 )

// longitud
nGrados := Val(SubStr( ::cLong, 1, 3 ) )
nMinutos := Val(SubStr( ::cLong, 4, 7 ) ) /60
::nLong := nGrados+ nMinutos* IIF( ::cNS ="W", -1, 1 )
::lGps := .t.
::cMsgErr := "OK"

// log de los datos leidos
// hay que mejorar la gestion de la dbf
// añadir fecha y hora
IF ::lLog .AND. VAL( ::cFix ) != 0
use (CURDIR()+"\gps.dbf" ) VIA "DBFCDX"
append blank
replace lon with ::nLong
replace lat WITH ::nlat
replace fix WITH VAL(::cFix)
replace sats WITH val(::cSats)
replace clong WITH ::cLong
replace cLat WITH ::cLat
USE
endif

RETURN nil

////////////////////////////////////////////////////////////
//
// GPRMC( cCad )
// Extrae los datos de una sentencia GPRMC
////////////////////////////////////////////////////////////

METHOD GPRMC( cCad ) CLASS TGps
Local cFecha

cFecha := StrToken( cCad, 10, "," )
::cDate := Substr( cFecha, 1, 2 ) + "/"+ Substr( cFecha, 3, 2) + "/"+ Substr(cFecha, 5, 2 )
::cSpeed := StrToken( cCad, 8, "," )
::lGps := .t.
::cMsgErr := "OK"

RETURN nil

/////////////////////////////////////////////////////////
METHOD End() CLASS TGps
::OTimer:Deactivate()
::oTimer:End()
ComClose( ::nHdlCom )
RETURN nil

//////////////////////////////////////////////////////////////////////
// ChkSum( cCad )
//
// Calcula el checksum de la sentencia NMEA
////////////////////////////////////////////////////////////////////7
STATIC Function ChkSum( cCad )
LOCAL c, nLen, nSum1, nSum2

nLen := AT( "*", cCad )
nSum1 := HexToDec( Substr( cCad, nLen +1, 2 ) ) // el checksum esta apartir de "*"
nSum2 := Asc( Substr( cCad, 1, 1 ) ) // cogemos el primer caracter a sumar

FOR c := 2 TO nLen -1
nSum2 := nXor( nSum2, Asc( Substr( cCad, c, 1 ) ) )
NEXT

RETURN IIF( nSum1 == nSum2, .t., .f. )

//////////////////////////////////////////
//
// Actualiza los datos de la ventana
//////////////////////////////////////////

Function UpdateControls( oWnd, oTimer )
LOCAL c
oTimer:Deactivate()
For c = 1 to Len(oWnd:aControls)
oWnd:aControls[c]:Refresh()
next

oTimer:Activate()
return .t.

/*
#pragma BEGINDUMP

#include <windows.h>
#include <math.h>
#include <hbapi.h>

// funcion de FW adaptada a FWPPC
HB_FUNC (HEXTODEC)
{
LPBYTE pString = ( LPBYTE ) hb_parc( 1 );
WORD w = 0, wLen = hb_parclen( 1 );
BYTE bChar;
LONG nHex = 0;

while( w < wLen )
{
bChar = pString[ w ] ;
if ( bChar >= 97 ) bChar -= 39; // lowercase
if ( bChar >= 65 ) bChar -= 7 ; // uppercase
bChar -= 48;
nHex += bChar * pow( 16, wLen - w - 1 );
w++;
}

hb_retnl( nHex );
}

#pragma ENDDUMP

Posted: **Thu Aug 17, 2017 2:03 pm**

Utilizo esta clase en muchos de mis proyectos.
Espero que te sirva

Code: Select all

/******************************

 TSerialComm.prg

 Clase para comunicar por puerto serie 
 
 Funciones nativas de harbour

 * hb_comClose( nPort )  --> lSuccess
 * hb_comDiscardChar( nPort, nChar | cChar ) --> lSuccess
 * hb_comErrorChar( nPort, nChar | cChar ) --> lSuccess
 * hb_comFlowChars( nPort, nXONchar | cXONchar, nXOFFchar | cXOFFchar ) --> lSuccess
 * hb_comFlowControl( nPort, @nOldFlow [, nNewFlow] ) --> lSuccess
 * hb_comFlowSet( nPort, nFlow ) --> lSuccess
 * hb_comFlush( nPort, [ nType = HB_COM_IOFLUSH ] ) --> lSuccess
 * hb_comGetDevice( nPort )  --> cDeviceName
 * hb_comGetDeviceHandle( nPort )  --> nHandle | F_ERROR
 * hb_comGetError( nPort ) --> nError
 * hb_comGetOSError( nPort ) --> nError
 * hb_comFindPort( cDeviceName [, lCreate = .F. ] ) --> nPort
 * hb_comInit( nPort, nBaud, cParity, nSize, nStop ) --> lSuccess
 * hb_comInputCount( nPort ) --> nCount
 * hb_comInputState( nPort ) --> nState
 * hb_comLastNum() --> nLastPortNumber
 * hb_comLSR( nPort, @nValue ) --> lSuccess
 * hb_comMCR( nPort, @nValue, nClear, nSet ) --> lSuccess
 * hb_comMSR( nPort, @nValue ) --> lSuccess
 * hb_comOpen( nPort ) --> lSuccess
 * hb_comOutputCount( nPort ) --> nCount
 * hb_comOutputState( nPort ) --> nState
 * hb_comSendBreak( nPort, [ nDuration = 50 ] ) --> lSuccess
 * hb_comSetDevice( nPort, cDeviceName ) --> lSuccess
 * hb_comSetError( nPort, nError ) --> NIL
 * hb_comRecv( nPort, @cBuffer, [ nLen = Len( cBuffer ) ], [ nTimeout = 0 ] ) --> nBytesRecv
 * hb_comSend( nPort, cBuffer, [ nLen = Len( cBuffer ) ], [ nTimeout = 0 ] ) --> nBytesSent
 
*/
#include "hbclass.ch"
#include "hbcom.ch"

#define CRLF HB_OsNewLine()

#xcommand DEFAULT <uVar1> := <uVal1> ;
               [, <uVarN> := <uValN> ] => ;
                  If( <uVar1> == nil, <uVar1> := <uVal1>, ) ;;
                [ If( <uVarN> == nil, <uVarN> := <uValN>, ); ]


CLASS TSerialComm

DATA nPort      INIT 1
DATA cPort      INIT "" 
DATA nBuffIn        INIT 1024
DATA nBuffOut   INIT 1024
DATA nSeconds       INIT 3

DATA nError     INIT 0
DATA cError         INIT ""
DATA lOpen      INIT .f.

CLASSDATA           shPort INIT { => }
CLASSDATA           sHbCMutex INIT hb_mutexCreate()


METHOD New( nPort , nBauds, nData, cParity,  nStopBits, nBufferSize ) CONSTRUCTOR
METHOD Close()
METHOD Write( cData )
METHOD Read( nChars, nTimeout )
METHOD ReadAll( nTimeout )
METHOD Flush()

ENDCLASS

METHOD New( nPort, nBauds, nData, cParity,  nStopBits, nBufferSize ) CLASS TSerialComm
local cPort, cOldPortName 

DEFAULT nPort := 1, nBauds := 9600, nData := 8,cParity := "N",  nStopBits := 1, nBufferSize := ::nBuffIn

cPort       := "\\.\COM" + hb_ntos ( nPort )
::cPort   := "COM"+hb_ntos( nPort )

::nPort     := Len( ::shPort ) + 1
::nError    := 0

if HB_ISSTRING( cPort )
    cOldPortName := hb_comGetDevice( ::nPort )
  hb_comSetDevice( ::nPort, cPort )
endif

   hb_comClose( ::nPort )
   if hb_comOpen( ::nPort )

      HB_SYMBOL_UNUSED( nBufferSize )

      if hb_comInit( ::nPort, nBauds, cParity, nData, nStopBits )
         ::shPort[ ::nPort ] := cOldPortName
         hb_mutexUnlock( ::sHbCMutex )
        ::lOpen := .t.
        else
         hb_comClose( ::nPort )
        ::lOpen := .f.
        ::nError := 1
        ::cError := "Error al inicializar puerto "+ ::cPort+ ", error: " + GetComError( hb_comGetError( ::nPort ) )
      endif
    else
            ::lOpen := .f.
            ::nError := 1
            ::cError := "Error al abrir el puerto "+ ::cPort+  ", error: " + GetComError( hb_comGetError( ::nPort ) )
   
   endif

    if ::nError == 0
        if cOldPortName != nil
        hb_comSetDevice( ::nPort, cOldPortName )
        endif
        endif
   hb_mutexUnlock( ::sHbCMutex )

return self

/**********************************************
*
* Write( cData )
*
***********************************************/
METHOD Write( cData )
local nLen
DEFAULT cData := ""
::nError := 0

do while hb_BLen( cData ) > 0
     nLen := hb_comSend( ::nPort, cData,, 1000 ) 
   if nLen <= 0
    ::nError := 1
    ::cError := "Write error: "+ GetComError( hb_comGetError( ::nPort ) )
     endif
    cData := hb_BSubStr( cData, nLen + 1 )
enddo
return nil

/******************************************************
*
* Read( nChars, nTimeout )
*
* Espera nChars caracteres por el puerto nTimeout segundos
* Finaliza al recibir el numero de cracteres esperados o al cumplir el timeout
*
*******************************************************/
METHOD Read( nChars, nTimeout ) CLASS TSerialComm
local cBuffIn, cBuffOut := "", nSeconds := Seconds()
local nBytes := 0, nBytTot := 0
DEFAULT nTimeout := ::nSeconds, nChars := ::nBuffIn

::nError := 0
cBuffIn  := Space( nChars )
do while ( ( Seconds() - nSeconds ) < nTimeout ) .AND. ( nBytTot < nChars )
    nBytes   := hb_comRecv( ::nPort, @cBuffIn,, 500 ) // timeout .5 segundoS o buffer lleno
    if nBytes > 0
      nSeconds  := Seconds()   // reinicia el temporizador
    endif
    nBytTot  += nBytes
    cBuffOut += Left( cBuffIn, nBytes )
enddo

return  cBuffOut


/************************************************************
*
* ReadAll( nTimeout )
*
* Lee caracteres del puerto un determinado tiempo 
*************************************************************/
METHOD ReadAll( nTimeout ) CLASS TSerialComm
local cBuffIn := Space( ::nBuffIn ), cBuffOut := "", nSeconds := Seconds()
local nBytes := 0, nBytTot := 0
DEFAULT nTimeout := ::nSeconds

::nError := 0

do while ( ( Seconds() - nSeconds ) < nTimeout ) 
    nBytes   := hb_comRecv( ::nPort, @cBuffIn,,500 ) // timeout .5 segundo o buffer lleno
    if nBytes > 0
      nSeconds  := Seconds()   // reinicia el temporizador
    endif
    nBytTot  += nBytes
    cBuffOut += Left( cBuffIn, nBytes )

enddo

return cBuffOut

/**********************************************
*
* Flush()
*
***********************************************/
METHOD  Flush() CLASS TSerialComm
::nError := 0
 if ! hb_comFlush( ::nPort, HB_COM_IOFLUSH )
    ::nError := 1
    ::cError := "Flush error: "+ GetComError( hb_comGetError( ::nPort ) )
endif

return nil

/**********************************************
*
* Close()
*
***********************************************/
METHOD  Close() CLASS TSerialComm
::nError := 0

hb_mutexLock( ::sHbCMutex )

if ::nPort $ ::shPort
    if hb_comClose( ::nPort )
    
    if ::shPort[ ::nPort ] != nil
        hb_comSetDevice( ::nPort, ::shPort[ ::nPort ] )
    endif
    hb_HDel( ::shPort, ::nPort )
        else
            ::nError := 1
        ::cError := "Error: "+ GetComError( hb_comGetError( ::nPort ) ) 
 endif
endif
hb_mutexUnlock( ::sHbCMutex )
::lOpen := .f.
return nil

/***********************************************
*
* Devuelve descripción del error
*
*/
static function GetComError( nCode )
local cDescripcion
    SWITCH nCode
        CASE HB_COM_ERR_WRONGPORT
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Puerto incorrecto"
            EXIT
        CASE HB_COM_ERR_CLOSED 
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Puerto cerrado."
            EXIT
        CASE HB_COM_ERR_TIMEOUT
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Timeout."
            EXIT
        CASE HB_COM_ERR_NOSUPPORT
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Puerto no saportado."
            EXIT
        CASE HB_COM_ERR_PARAMVALUE
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Error de parámetro."
            EXIT
        CASE HB_COM_ERR_BUSY
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - En uso por otra aplicacíón."
            EXIT
        CASE HB_COM_ERR_OTHER
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Otros errores."
            EXIT
        CASE HB_COM_ERR_ALREADYOPEN
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Puerto ya está abierto."
            EXIT
        CASE HB_COM_ERR_IO
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - I/O"
            EXIT
        CASE HB_COM_ERR_PIPE
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - PIPE."    
            EXIT
        CASE HB_COM_ERR_ACCESS
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Puerto no accesible." 
            EXIT
        CASE HB_COM_ERR_NOCOM
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - El puerto no existe"  
            EXIT
        OTHERWISE
            cDescripcion := AllTrim( Str( nCode, 2,0 ) )+ " - Error desconocido"
    
    ENDSWITCH   

return cDescripcion

FiveTech Software tech support forums

Rutina para leer Gps

Rutina para leer Gps

Re: Rutina para leer Gps