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
Rutina para leer Gps
-
Busmatic_wpb
- Posts: 162
- Joined: Wed Feb 22, 2017 2:19 am
Rutina para leer Gps
Regards.
S.I.T.U.
Sistemas Inteligentes de transporte urbano
http://www.situcr.com
_@Situcr.com
Desarrollos BA4/B4j androide
S.I.T.U.
Sistemas Inteligentes de transporte urbano
http://www.situcr.com
_@Situcr.com
Desarrollos BA4/B4j androide
Re: Rutina para leer Gps
Utilizo esta clase en muchos de mis proyectos.
Espero que te sirva
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
Saludos
Salvador
Salvador