GEr

[frazato]

Boa tarde!
sei que existe essa função "HB_JSONDecode()" em harbour e xharbour mais versões mais novas, mais como tenho o meu sistema em xharbour 0.99 e não estou podendo mudar para as mais novas, até mudei mais tive problemas com a gtwvw e não está legal ainda, ai consegui achar o código fonte mais não dou conta de usa-lo no xharbour, gostaria de ajuda para deixar essa função usual no xharobur.

Código: Selecionar todos

REQUEST HB_JSONENCODE
REQUEST HB_JSONDECODE


#ifndef HB_JSON_H_
#define HB_JSON_H_

#include "hbapi.h"

HB_EXTERN_BEGIN

extern char *  hb_jsonEncode( PHB_ITEM pValue, HB_SIZE * pnLen, HB_BOOL fHuman );
extern HB_SIZE hb_jsonDecode( const char * szSource, PHB_ITEM pValue );

HB_EXTERN_END

#endif /* HB_JSON_H_ */






#include <math.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapistr.h"

typedef struct
{
   char *   pBuffer;
   char *   pHead;
   HB_SIZE  nAlloc;
   void **  pId;
   HB_SIZE  nAllocId;
   HB_BOOL  fHuman;
} HB_JSON_ENCODE_CTX, * PHB_JSON_ENCODE_CTX;

#if defined( HB_OS_UNIX ) && !defined( HB_EOL_CRLF )
   static const char s_szEol[ 2 ] = { HB_CHAR_LF, 0 };
   static const int  s_iEolLen = 1;
#else
   static const char s_szEol[ 3 ] = { HB_CHAR_CR, HB_CHAR_LF, 0 };
   static const int  s_iEolLen = 2;
#endif

#define INDENT_SIZE   2

static void _hb_jsonCtxAdd( PHB_JSON_ENCODE_CTX pCtx, const char * szString, HB_SIZE nLen )
{
   if( pCtx->pHead + nLen >= pCtx->pBuffer + pCtx->nAlloc )
   {
      HB_SIZE nSize = pCtx->pHead - pCtx->pBuffer;

      pCtx->nAlloc += ( pCtx->nAlloc << 1 ) + nLen;
      pCtx->pBuffer = ( char * ) hb_xrealloc( pCtx->pBuffer, pCtx->nAlloc );
      pCtx->pHead = pCtx->pBuffer + nSize;
   }
   if( szString )
   {
      hb_xmemcpy( pCtx->pHead, szString, nLen );
      pCtx->pHead += nLen;
   }
}

static void _hb_jsonCtxAddIndent( PHB_JSON_ENCODE_CTX pCtx, HB_SIZE nCount )
{
   if( nCount > 0 )
   {
      if( pCtx->pHead + nCount >= pCtx->pBuffer + pCtx->nAlloc )
      {
         HB_SIZE nSize = pCtx->pHead - pCtx->pBuffer;

         pCtx->nAlloc += ( pCtx->nAlloc << 1 ) + nCount;
         pCtx->pBuffer = ( char * ) hb_xrealloc( pCtx->pBuffer, pCtx->nAlloc );
         pCtx->pHead = pCtx->pBuffer + nSize;
      }
      hb_xmemset( pCtx->pHead, ' ', nCount );
      pCtx->pHead += nCount;
   }
}

static void _hb_jsonEncode( PHB_ITEM pValue, PHB_JSON_ENCODE_CTX pCtx, HB_SIZE nLevel )
{
   if( nLevel >= pCtx->nAllocId )
   {
      pCtx->nAllocId += 8;
      pCtx->pId = ( void ** ) hb_xrealloc( pCtx->pId, sizeof( void * ) * pCtx->nAllocId );
   }

   /* Protection against recursive structures */
   if( HB_IS_ARRAY( pValue ) || HB_IS_HASH( pValue ) )
   {
      void * id = HB_IS_HASH( pValue ) ? hb_hashId( pValue ) : hb_arrayId( pValue );
      HB_SIZE nIndex;

      for( nIndex = 0; nIndex < nLevel; nIndex++ )
      {
         if( pCtx->pId[ nIndex ] == id )
         {
            _hb_jsonCtxAdd( pCtx, "null", 4 );
            return;
         }
      }
      pCtx->pId[ nLevel ] = id;
   }

   if( HB_IS_STRING( pValue ) )
   {
      const char * szString = hb_itemGetCPtr( pValue );
      HB_SIZE nPos, nPos2, nLen = hb_itemGetCLen( pValue );

      _hb_jsonCtxAdd( pCtx, "\"", 1 );

      nPos = 0;
      while( nPos < nLen )
      {
         nPos2 = nPos;
         while( * ( ( const unsigned char * ) szString + nPos2 ) >= ' ' &&
                szString[ nPos2 ] != '\\' && szString[ nPos2 ] != '\"' )
            nPos2++;
         if( nPos2 > nPos )
         {
            _hb_jsonCtxAdd( pCtx, szString + nPos, nPos2 - nPos );
            nPos = nPos2;
            continue;
         }

         switch( szString[ nPos ] )
         {
            case '\\':
               _hb_jsonCtxAdd( pCtx, "\\\\", 2 );
               break;
            case '\"':
               _hb_jsonCtxAdd( pCtx, "\\\"", 2 );
               break;
            case '\b':
               _hb_jsonCtxAdd( pCtx, "\\b", 2 );
               break;
            case '\f':
               _hb_jsonCtxAdd( pCtx, "\\f", 2 );
               break;
            case '\n':
               _hb_jsonCtxAdd( pCtx, "\\n", 2 );
               break;
            case '\r':
               _hb_jsonCtxAdd( pCtx, "\\r", 2 );
               break;
            case '\t':
               _hb_jsonCtxAdd( pCtx, "\\t", 2 );
               break;
            default:
            {
               char buf[ 8 ];
               hb_snprintf( buf, sizeof( buf ), "\\u00%02X", ( unsigned char ) szString[ nPos ] );
               _hb_jsonCtxAdd( pCtx, buf, 6 );
               break;
            }
         }
         nPos++;
      }
      _hb_jsonCtxAdd( pCtx, "\"", 1 );
   }
   else if( HB_IS_NUMINT( pValue ) )
   {
      char buf[ 32 ];

      hb_snprintf( buf, sizeof( buf ), "%" PFHL "d", hb_itemGetNInt( pValue ) );
      _hb_jsonCtxAdd( pCtx, buf, strlen( buf ) );
   }
   else if( HB_IS_NUMERIC( pValue ) )
   {
      char buf[ 64 ];
      int iDec;
      double dblValue = hb_itemGetNDDec( pValue, &iDec );

      hb_snprintf( buf, sizeof( buf ), "%.*f", iDec, dblValue );
      _hb_jsonCtxAdd( pCtx, buf, strlen( buf ) );
   }
   else if( HB_IS_NIL( pValue ) )
   {
      _hb_jsonCtxAdd( pCtx, "null", 4 );
   }
   else if( HB_IS_LOGICAL( pValue ) )
   {
      if( hb_itemGetL( pValue ) )
         _hb_jsonCtxAdd( pCtx, "true", 4 );
      else
         _hb_jsonCtxAdd( pCtx, "false", 5 );

   }
   else if( HB_IS_DATE( pValue ) )
   {
      char szBuffer[ 10 ];

      hb_itemGetDS( pValue, szBuffer + 1 );
      szBuffer[ 0 ] = '\"';
      szBuffer[ 9 ] = '\"';
      _hb_jsonCtxAdd( pCtx, szBuffer, 10 );
   }
   else if( HB_IS_TIMESTAMP( pValue ) )
   {
      char szBuffer[ 19 ];
      hb_itemGetTS( pValue, szBuffer + 1 );
      szBuffer[ 0 ] = '\"';
      szBuffer[ 18 ] = '\"';
      _hb_jsonCtxAdd( pCtx, szBuffer, 19 );
   }
   else if( HB_IS_ARRAY( pValue ) )
   {
      HB_SIZE nLen = hb_itemSize( pValue );

      if( nLen )
      {
         HB_SIZE nIndex;

         if( pCtx->fHuman )
            _hb_jsonCtxAddIndent( pCtx, nLevel * INDENT_SIZE );

         _hb_jsonCtxAdd( pCtx, "[", 1 );

         for( nIndex = 1; nIndex <= nLen; nIndex++ )
         {
            PHB_ITEM pItem = hb_arrayGetItemPtr( pValue, nIndex );

            if( nIndex > 1 )
               _hb_jsonCtxAdd( pCtx, ",", 1 );

            if( pCtx->fHuman )
              _hb_jsonCtxAdd( pCtx, s_szEol, s_iEolLen );

            if( pCtx->fHuman &&
                !( ( HB_IS_ARRAY( pItem ) || HB_IS_HASH( pItem ) ) &&
                   hb_itemSize( pItem ) > 0 ) )
               _hb_jsonCtxAddIndent( pCtx, ( nLevel + 1 ) * INDENT_SIZE );

            _hb_jsonEncode( pItem, pCtx, nLevel + 1 );
         }
         if( pCtx->fHuman )
         {
           _hb_jsonCtxAdd( pCtx, s_szEol, s_iEolLen );
           _hb_jsonCtxAddIndent( pCtx, nLevel * INDENT_SIZE );
         }
         _hb_jsonCtxAdd( pCtx, "]", 1 );
      }
      else
         _hb_jsonCtxAdd( pCtx, "[]", 2 );
   }
   else if( HB_IS_HASH( pValue ) )
   {
      HB_SIZE nLen = hb_hashLen( pValue );

      if( nLen )
      {
         HB_SIZE nIndex;

         if( pCtx->fHuman )
            _hb_jsonCtxAddIndent( pCtx, nLevel * INDENT_SIZE );

         _hb_jsonCtxAdd( pCtx, "{", 1 );

         for( nIndex = 1; nIndex <= nLen; nIndex++ )
         {
            PHB_ITEM pKey = hb_hashGetKeyAt( pValue, nIndex );

            if( HB_IS_STRING( pKey ) )
            {
               PHB_ITEM pItem = hb_hashGetValueAt( pValue, nIndex );
               if( nIndex > 1 )
                  _hb_jsonCtxAdd( pCtx, ",", 1 );

               if( pCtx->fHuman )
               {
                  _hb_jsonCtxAdd( pCtx, s_szEol, s_iEolLen );
                  _hb_jsonCtxAddIndent( pCtx, ( nLevel + 1 ) * INDENT_SIZE );
               }
               _hb_jsonEncode( pKey, pCtx, nLevel + 1 );

               if( pCtx->fHuman )
               {
                  _hb_jsonCtxAdd( pCtx, " : ", 3 );
                  if( ( HB_IS_ARRAY( pItem ) || HB_IS_HASH( pItem ) ) && hb_itemSize( pItem ) > 0 )
                     _hb_jsonCtxAdd( pCtx, s_szEol, s_iEolLen );
               }
               else
                  _hb_jsonCtxAdd( pCtx, ":", 1 );

               _hb_jsonEncode( pItem, pCtx, nLevel + 1 );
            }
         }
         if( pCtx->fHuman )
         {
           _hb_jsonCtxAdd( pCtx, s_szEol, s_iEolLen );
           _hb_jsonCtxAddIndent( pCtx, nLevel * INDENT_SIZE );
         }
         _hb_jsonCtxAdd( pCtx, "}", 1 );
      }
      else
         _hb_jsonCtxAdd( pCtx, "{}", 2 );
   }
   else
   {
      /* All unsupported types are replacd by null */
      _hb_jsonCtxAdd( pCtx, "null", 4 );
   }
}

static const char * _skipws( const char * szSource )
{
   while( *szSource == ' ' || *szSource == '\t' || *szSource == '\n' || *szSource == '\r') szSource++;
   return szSource;
}

static const char * _hb_jsonDecode( const char * szSource, PHB_ITEM pValue )
{
   if( *szSource == '\"' )
   {
      char * szDest, * szHead;
      HB_SIZE nAlloc = 16;

      szHead = szDest = ( char * ) hb_xgrab( nAlloc );
      szSource++;
      while( *szSource != '\"' )
      {
         if( szHead + 6 >= szDest + nAlloc )
         {
            HB_SIZE nLen = szHead - szDest;
            nAlloc += nAlloc << 1;
            szDest = ( char * ) hb_xrealloc( szDest, nAlloc );
            szHead = szDest + nLen;
         }
         if( *szSource == '\\' )
         {
            szSource++;
            switch( *szSource )
            {
               case '\"':
                  *szHead++ = '\"';
                  break;
               case '\\':
                  *szHead++ = '\\';
                  break;
               case '/':
                  *szHead++ = '/';
                  break;
               case 'b':
                  *szHead++ = '\b';
                  break;
               case 'f':
                  *szHead++ = '\f';
                  break;
               case 'n':
                  *szHead++ = '\n';
                  break;
               case 'r':
                  *szHead++ = '\r';
                  break;
               case 't':
                  *szHead++ = '\t';
                  break;
               case 'u':
               {
                  HB_WCHAR wc = 0;
                  int i;

                  for( i = 0; i < 4; i++ )
                  {
                     char c = *++szSource;
                     wc <<= 4;
                     if( c >= '0' && c <= '9' )
                        wc += c - '0';
                     else if( c >= 'A' && c <= 'F' )
                        wc += c - 'A' + 10;
                     else if( c >= 'a' && c <= 'f' )
                        wc += c - 'a' + 10;
                     else
                     {
                        hb_xfree( szDest );
                        return NULL;
                     }
                  }
                  szHead += hb_cdpU16ToStr( hb_vmCDP(), HB_CDP_ENDIAN_NATIVE,
                                            &wc, 1,
                                            szHead, szDest + nAlloc - szHead );
                  break;
               }
               default:
               {
                  hb_xfree( szDest );
                  return NULL;
               }
            }
            szSource++;
         }
         else if( * ( const unsigned char * ) szSource >= ' ' )
            *szHead++ = *szSource++;
         else
         {
            hb_xfree( szDest );
            return NULL;
         }
      }
      hb_itemPutCL( pValue, szDest, szHead - szDest );
      hb_xfree( szDest );
      return szSource + 1;
   }
   else if( *szSource == '-' || ( *szSource >= '0' && *szSource <= '9' ) )
   {
      /* NOTE: this function is much less strict to number format than
               JSON syntax definition. This is allowed behaviour [Mindaugas] */
      HB_MAXINT nValue = 0;
      double dblValue = 0;
      HB_BOOL fNeg, fDbl = HB_FALSE;

      fNeg = *szSource == '-';
      if( fNeg )
         szSource++;

      while( *szSource >= '0' && *szSource <= '9' )
      {
         nValue = nValue * 10 + *szSource - '0';
         szSource++;
      }
      if( *szSource == '.' )
      {
         double mult = 1;

         dblValue = ( double ) nValue;
         fDbl = HB_TRUE;
         szSource++;
         while( *szSource >= '0' && *szSource <= '9' )
         {
            mult /= 10;
            dblValue += ( ( double ) ( *szSource - '0' ) ) * mult;
            szSource++;
         }
      }
      if( *szSource == 'e' || *szSource == 'E' )
      {
         HB_BOOL fNegExp;
         int iExp = 0;

         szSource++;
         fNegExp = *szSource == '-';
         if( fNegExp )
            szSource++;

         szSource++;
         while( *szSource >= '0' && *szSource <= '9' )
         {
            iExp = iExp * 10 + *szSource - '0';
            szSource++;
         }
         if( ! fDbl )
         {
            dblValue = ( double ) nValue;
            fDbl = HB_TRUE;
         }
         dblValue *= pow( 10.0, ( double ) ( fNegExp ? -iExp : iExp ) );
      }

      if( fDbl )
         hb_itemPutND( pValue, fNeg ? -dblValue : dblValue );
      else
         hb_itemPutNInt( pValue, fNeg ? -nValue : nValue);
      return szSource;
   }
   else if( ! strncmp( szSource, "null", 4 ) )
   {
      hb_itemClear( pValue );
      return szSource + 4;
   }
   else if( ! strncmp( szSource, "true", 4 ) )
   {
      hb_itemPutL( pValue, HB_TRUE );
      return szSource + 4;
   }
   else if( ! strncmp( szSource, "false", 5 ) )
   {
      hb_itemPutL( pValue, HB_FALSE );
      return szSource + 5;
   }
   else if( *szSource == '[' )
   {
      hb_arrayNew( pValue, 0 );
      szSource = _skipws( szSource + 1 );
      if( *szSource != ']' )
      {
         PHB_ITEM pItem = hb_itemNew( NULL );

         for( ;; )
         {
            szSource = _hb_jsonDecode( szSource, pItem );
            if( ! szSource )
            {
               hb_itemRelease( pItem );
               return NULL;
            }
            hb_arrayAddForward( pValue, pItem );

            szSource = _skipws( szSource );
            if( *szSource == ',' )
            {
               szSource = _skipws( szSource + 1 );
               continue;
            }
            else if( *szSource == ']' )
               break;
            else
            {
               hb_itemRelease( pItem );
               return NULL;
            }
         }
         hb_itemRelease( pItem );
      }
      return szSource + 1;
   }
   else if( *szSource == '{' )
   {
      hb_hashNew( pValue );
      hb_hashSetFlags( pValue, HB_HASH_KEEPORDER );
      szSource = _skipws( szSource + 1 );
      if( *szSource != '}' )
      {
         PHB_ITEM pItemKey = hb_itemNew( NULL );
         PHB_ITEM pItemValue = hb_itemNew( NULL );

         for( ;; )
         {
            if( ( szSource = _hb_jsonDecode( szSource, pItemKey ) ) == NULL ||
                ! HB_IS_STRING( pItemKey ) ||
                * ( szSource = _skipws( szSource ) ) != ':' ||
                ( szSource = _hb_jsonDecode( _skipws( szSource + 1 ), pItemValue ) ) == NULL)
            /* Do we need to check if key does not exist yet? */
            {
               hb_itemRelease( pItemKey );
               hb_itemRelease( pItemValue );
               return NULL;
            }

            hb_hashAdd( pValue, pItemKey, pItemValue );
            szSource = _skipws( szSource );
            if( *szSource == ',' )
            {
               szSource = _skipws( szSource + 1 );
               continue;
            }
            else if( *szSource == '}' )
               break;
            else
            {
               hb_itemRelease( pItemKey );
               hb_itemRelease( pItemValue );
               return NULL;
            }
         }
         hb_itemRelease( pItemKey );
         hb_itemRelease( pItemValue );
      }
      return szSource + 1;
   }
   return NULL;
}

/* C level API functions */

char * hb_jsonEncode( PHB_ITEM pValue, HB_SIZE * pnLen, HB_BOOL fHuman )
{
   PHB_JSON_ENCODE_CTX pCtx;
   char * szRet;
   HB_SIZE nLen;

   pCtx = ( PHB_JSON_ENCODE_CTX ) hb_xgrab( sizeof( HB_JSON_ENCODE_CTX ) );
   pCtx->nAlloc = 16;
   pCtx->pHead = pCtx->pBuffer = ( char * ) hb_xgrab( pCtx->nAlloc );
   pCtx->nAllocId = 8;
   pCtx->pId = ( void ** ) hb_xgrab( sizeof( void * ) * pCtx->nAllocId );
   pCtx->fHuman = fHuman;

   _hb_jsonEncode( pValue, pCtx, 0 );

   nLen = pCtx->pHead - pCtx->pBuffer;
   szRet = ( char * ) hb_xrealloc( pCtx->pBuffer, nLen + 1 );
   szRet[ nLen ] = '\0';
   hb_xfree( pCtx->pId );
   hb_xfree( pCtx );
   if( pnLen )
      *pnLen = nLen;
   return szRet;
}

HB_SIZE hb_jsonDecode( const char * szSource, PHB_ITEM pValue )
{
   PHB_ITEM pItem = pValue ? pValue : hb_itemNew( NULL );
   const char * sz;

   sz = szSource ? _hb_jsonDecode( _skipws( szSource ), pItem ) : NULL;
   if( ! pValue )
      hb_itemRelease( pItem );
   if( sz )
      return sz - szSource;
   return 0;
}

/* Harbour level API functions */

HB_FUNC( HB_JSONENCODE )
{
   PHB_ITEM pItem = hb_param( 1, HB_IT_ANY );

   if( pItem )
   {
      HB_SIZE nLen;

      char * szRet = hb_jsonEncode( pItem, &nLen, hb_parl( 2 ) );
      hb_retclen_buffer( szRet, nLen );
   }
}

HB_FUNC( HB_JSONDECODE )
{
   PHB_ITEM pItem = hb_itemNew( NULL );

   hb_retns( ( HB_ISIZ ) hb_jsonDecode( hb_parc( 1 ), pItem ) );
   hb_itemParamStoreForward( 2, pItem );
   hb_itemRelease( pItem );
}

[JoséQuintas]

Tente achar a do próprio XHarbour (se é que essa não é dele).
Pelo que parece, envolve definições da API Interna do Harbour, e talvez a do XHarbour seja mais próxima.

[frazato]

Bom dia!!
To lascado, vou ter que arrumar alguma coisa para ler os arquivos json ou criar um executavel em harbour para ler e devolver em um dbf e tratar pelo meu ERP.

Obrigado

Frazato

[JoséQuintas]

Ou então... tentar resolver o que está adiando da GTWVW.

A GTWVW não é uma LIB oficial, no 3.2 fica em extras, no 3.4 até faz parte mas... o 3.4 morreu.
Acho que a alternativa mais próxima é mesmo a GTWVG, uma vez que WVW e WVG usam API Windows.
Mas não sei se no XHarbour acompanhou as mesmas atualizações do Harbour.

Me mostrou uma vez a WVWTools, de certa forma ela segue o estilo GTWVG, usando API Windows.
É questão de tentar encontrar equivalentes, procurando não deixar fonte muito preso a nenhuma.

[JoséQuintas]

Talvez tentar a GTHWGUI, que tem pra Windows e Linux.
O problema é que precisamos da ajuda de quem já usa HWGUI, mas isso parece complicado.
Eles poderiam rapidamente identificar se vale a pena, se vão estar disponíveis recursos GUI nessa janela console.

[Itamar M. Lins Jr.]

Olá!
Lá atrás, eu alertei para o afunilamento de usar xHarbour + RDDSQL + WVG, WVW, etc.
A melhor opção no meu ponto de vista hoje, para quem está chegando é a Minigui do Ivanil Marcelino. Para quem está chegando!
Eu mesmo comecei na Hwgui, antes tinha experimentado a Minigui na época, preferi a Hwgui, mas tem muito tempo isso.
Vantagens da Hwgui "COMPARANDO" a troca com a WVW/WVG são inúmeras, o código é bem menor e a sintaxe da Hwgui muito mais legível para o programador xBase.
Hwgui roda SOLIDA, sem bugs, importantes.
Eu mesmo fiz essa transição da WVG/GTWIN/WVT para HWGUI. Sei do que estou falando, sentir na pele o que é mudar naquela época a
dificuldade que foi muito maior, hoje tem mais usuários avançados na Hwgui que ajudam nessa transição.

Tá bem, mas muito bem "consolidado" o ADO com Harbour sem nenhum intermediário que afasta essa ideia de SQLRDD imitar DBF dentro de motores SQL. A pessoa migra p/ algum motor SQL usando LOCATE, SEEK, DBCREATE, "vê só" se isso é avanço ?
Após muitos debates aqui no forum sabemos que o verdadeiro ganho é usar os COMANDOS SQL, sem falar na perda de velocidade dessa arquitetura e correções de possíveis BUGs, avanços de novos comandos SQL, etc... que não tem nos comandos do SQLRDD. A não ser que eles adicionem isso posteriormente, mas fica dependendo deles e não do SGBD que de fato adicionou novos recursos.
ADO é relativamente fácil, simples, funciona muito bem acessa praticamente todas as bases de dados.

Saudações,
Itamar M. Lins Jr.

[frazato]

Tarde!
Como não consegui fazer funcionar a rotina acima, por falta de conhecimento e não achei o fonte e também e não posso no momento mudar para uma versão mais nova, fiz uma rotina para ler o json, tá meio tosca mais funciona.

Código: Selecionar todos

//---------------------------------------------------
Functio JAF_JSon(cArq)
Local cLidos2 

*cArqJson := 'c:\Nutricionista\buffer.txt'
cArqJson := cArq


    cLinhaTxt   := Memoread(cArqJson)
    Linha       := cLinhaTxt

    nLinhalidas := 0
    Linhatotal  := Len(Linha)
    cLinhaTxt   := Linha
    cArqXmlLido := Linha

    cLidos2 := {}

    Do While .t.
           
	    nPosINI     := At(["ean":],cLinhaTxt)
	    nPosFim     := At(["cpf":],cLinhaTxt)

	    cMatriz     := Substr(cLinhaTxt,nPosINI, (nPosFim-nPosINI))

	    If nPosIni # 0
	       Aadd(cLidos2,Hb_aTokens(cMatriz,"," ) )
	    Endif
    
	    nLinhalidas  += nPosFim

            If nPosFim == 0
               Exit
            Endif
            nSize         := Linhatotal-nLinhaLidas
            cLinha        := Right(cLinhaTxt,nSize)
            cLinhaTxt     := cLinha
            If nLinhaLidas >= Linhatotal
               Exit
            Endif
    Enddo
/*

For i:= 1 to Len(cLidos2)
    ? Limpa(cLidos2[i,1],'ean:')
    ? Limpa(cLidos2[i,2],'preco_promocao:')
    ? Limpa(cLidos2[i,3],'preco_crt_dm:')
    ? Limpa(cLidos2[i,5],'data_termino:')
Next
*/
Return cLidos2

[JoséQuintas]

Talvez alguém com conhecimento em C consiga converter a rotina pra PRG, já que a questão não é tanto velocidade.

Achei interessante o desafio, mas não é fácil.
Comecei por um simples de um json só com array string.

Código: Selecionar todos

REQUEST HB_CODEPAGE_PTISO

#define EXCLUDE_A Chr(13) + Chr(10)
#define EXCLUDE_B EXCLUDE_A + " "

PROCEDURE Main

   LOCAL cTxt := hb_MemoRead( "d:\fontes\integra\sql\json\gameforca.json" ), aHash

   Set( _SET_CODEPAGE, "PTISO" )
   SetMode( 40, 100 )

   Altd()
   aHash := ze_JsonDecode( cTxt )
   ( aHash )
   Altd()
   Inkey(0)

   RETURN

FUNCTION ze_JsonDecode( cTxt )

   LOCAL nPos := 1, aHash, nLen

   nLen := Len( cTxt )
   DO WHILE Substr( cTxt, nPos, 1 ) $ EXCLUDE_B .AND. nPos < nLen
      nPos += 1
   ENDDO
   IF Substr( cTxt, nPos, 1 ) == "["
      aHash := {}
      ze_JsonDecodeArray( aHash, cTxt, @nPos, nLen )
   ELSE
      aHash := hb_Hash()
      //ze_JsonDecodeHash( aHash, cTxt, @nPos, nLen )
   ENDIF

   RETURN aHash

FUNCTION ze_JsonDecodeArray( aHash, cTxt, nPos, nLen )

   nPos += 1
   DO WHILE Substr( cTxt, nPos, 1 ) != "]" .AND. nPos <= nLen
      IF ! Substr( cTxt, nPos, 1 ) $ EXCLUDE_B + ","
         IF Substr( cTxt, nPos, 1 ) == "["
            AAdd( aHash, {} )
            ze_JsonDecodeArray( Atail( aHash ), cTxt, @nPos, nLen )
         ELSEIF Substr( cTxt, nPos, 1 ) == ["]
            AAdd( aHash, ze_JsonDecodeString( cTxt, @nPos, nLen ) )
         ENDIF
      ENDIF
      nPos += 1
   ENDDO

   RETURN Nil

FUNCTION ze_JsonDecodeString( cTxt, nPos, nLen )

   LOCAL nPos2, xValue

   nPos += 1
   ( nLen )
   nPos2 := hb_At( ["], cTxt, nPos ) - 1
   IF nPos2 == 0
      RETURN ""
   ENDIF
   nLen := nPos2 - nPos + 1
   xValue := Substr( cTxt, nPos, nLen )
   nPos += nLen + 1

   RETURN xValue

Aqui no debug

Tinha postado um incompleto, e falei que não ia mexer mais.
Vi que o problema foi não ter passado posição por referência, além de alguns ajustes.
Acabei editando a mensagem anterior com os ajustes.
A idéia é ir decodificando uma letra de cada vez, até acabar a string.
Tive a impressão de que é parecido com isso que a rotina em C faz.

Outra imagem, no debug, com o conteúdo json que foi convertido.

Infelizmente, a rotina só vale pra json com array, a não ser que sejam acrescentadas as outras opções.

[JoséQuintas]

Só complemento:

Basicamente:
- Se encontrar "[" significa que é array, e começa a extrair elementos.
- Se encontrar "{" é hash, mas não criei essa parte
- Se no array encontrar Aspas, é string, na decodificação de string pulei direto pras próximas aspas
- Não criei pra outros tipos de valores (números, datas, etc)

nPos é o que vai aumentando a posição para o próximo caractere, conforme vai passando pelas rotinas.

- Teria que ajustar pra separar os elementos pela vírgula no array
- Teria que fazer o mesmo no hash, e também pegar o nome de cada elemento

[JoséQuintas]

Não pode cortar caminho.
Por exemplo, considerar array de "[" até "]"
Pensei nisso, mas se fizer isso não dá certo, porque um array pode conter sub-array, e vai acabar encontrando mais "]" internos ao que realmente termina o array inicial.

É doido o troço.
Acho que a rotina em C procura por "[", "{", aspas, número, pra determinar qual o tipo do elemento a decodificar.
E provavelmente use as vírgulas pra determinar os elementos do array/hash, desde que não estejam dentro de aspas.

Lembrando que pode entrar a codepage no meio, ou os caracteres especiais onde existe "\" antes deles.

Quem tiver conhecimento em C, pode aproveitar a rotina do Harbour.
Vai ficar mais lento em PRG, mas... melhor do que nenhuma rotina.

[JoséQuintas]

Uia
Agora array, subarray, string, número, null e boolean.
Falta achar exemplo dos outros tipos.
O json usado pra teste está no final do fonte.

Código: Selecionar todos

REQUEST HB_CODEPAGE_PTISO

#define EXCLUDE_A Chr(13) + Chr(10)
#define EXCLUDE_B EXCLUDE_A + " "

PROCEDURE Main

   LOCAL aHash, cTxt := TxtJson()

   Set( _SET_CODEPAGE, "PTISO" )
   SetMode( 40, 100 )

   Altd()
   aHash := ze_JsonDecode( cTxt )
   ( aHash )
   Altd()
   Inkey(0)

   RETURN

FUNCTION ze_JsonDecode( cTxt )

   LOCAL nPos := 1, aHash, nLen

   nLen := Len( cTxt )
   DO WHILE Substr( cTxt, nPos, 1 ) $ EXCLUDE_B .AND. nPos < nLen
      nPos += 1
   ENDDO
   IF Substr( cTxt, nPos, 1 ) == "["
      aHash := {}
      ze_JsonDecodeArray( aHash, cTxt, @nPos, nLen )
   ELSE
      aHash := hb_Hash()
      //ze_JsonDecodeHash( aHash, cTxt, @nPos, nLen )
   ENDIF

   RETURN aHash

FUNCTION ze_JsonDecodeArray( aHash, cTxt, nPos, nLen )

   nPos += 1
   DO WHILE Substr( cTxt, nPos, 1 ) != "]" .AND. nPos <= nLen
      IF ! Substr( cTxt, nPos, 1 ) $ EXCLUDE_B + ","
         IF Substr( cTxt, nPos, 1 ) == "["
            AAdd( aHash, {} )
            ze_JsonDecodeArray( Atail( aHash ), cTxt, @nPos, nLen )
         ELSEIF Substr( cTxt, nPos, 1 ) == ["]
            AAdd( aHash, ze_JsonDecodeString( cTxt, @nPos, nLen ) )
         ELSEIF Substr( cTxt, nPos, 1 ) $ "-0123456789"
            AAdd( aHash, ze_JsonDecodeNumber( cTxt, @nPos, nLen ) )
         ELSEIF Upper( Substr( cTxt, nPos, 1 ) ) $ "TF"
            AAdd( aHash, ze_JsonDecodeBoolean( cTxt, @nPos, nLen ) )
         ELSEIF Upper( Substr( cTxt, nPos, 1 ) ) $ "N"
            AAdd( aHash, ze_JsonDecodeNull( cTxt, @nPos, nLen ) )
         ENDIF
      ENDIF
      nPos += 1
   ENDDO

   RETURN Nil

FUNCTION ze_JsonDecodeString( cTxt, nPos, nLen )

   LOCAL nPos2, xValue

   nPos += 1
   ( nLen )
   nPos2 := hb_At( ["], cTxt, nPos ) - 1
   IF nPos2 == 0
      RETURN ""
   ENDIF
   nLen := nPos2 - nPos + 1
   xValue := Substr( cTxt, nPos, nLen )
   nPos += nLen + 1

   RETURN xValue

FUNCTION ze_JsonDecodeNumber( cTxt, nPos, nLen )

   LOCAL xValue := ""

   ( nLen )
   nPos += 1
   DO WHILE Substr( cTxt, nPos, 1 ) $ "-0123456789."
      xValue += Substr( cTxt, nPos, 1 )
      nPos += 1
   ENDDO

   RETURN Val( xValue )

FUNCTION ze_JsonDecodeBoolean( cTxt, nPos, nLen )

   LOCAL xValue := ""

   ( nLen )
   nPos += 1
   DO WHILE Upper( Substr( cTxt, nPos, 1 ) ) $ "TRUEFALSE"
      xValue += Substr( cTxt, nPos, 1 )
      nPos += 1
   ENDDO

   RETURN iif( Upper( xValue ) == "TRUE", .T., .F. )

FUNCTION ze_JsonDecodeNull( cTxt, nPos, nLen )

   LOCAL xValue := ""

   ( nLen )
   nPos += 1
   DO WHILE Upper( Substr( cTxt, nPos, 1 ) ) $ "NULL"
      xValue += Substr( cTxt, nPos, 1 )
      nPos += 1
   ENDDO

   RETURN Nil

FUNCTION TxtJson()

RETURN ;
   '[' + ;
   '[ "1.000", "ENTRADA E/OU AQUISICAO NO ESTADO", 0, 0, 0, 0 ],' + ;
   '[ "1.100", "COMPRA P/IND, COM E/OU PREST.SERVICOS", 0, 0, 0, 0 ],' + ;
   '[ "1.101", "COMPRA P/ INDUSTRIALIZACAO OU PRODUCAO RURAL", 1, 0, 0, 0 ],' + ;
   '[ "1.102", "COMPRA P/ COMERCIALIZACAO", 1, 0, 0, 0 ],' + ;
   '[ "1.111", "COMPRA P/ INDUSTRIALIZACAO DE MERCADORIA RECEBIDA ANTERIORMENTE EM CONSIGNACAO INDUSTRIAL", 1, 0, 0, 0 ],' + ;
   '[ "1.113", "COMPRA P/ COMERCIALIZACAO, DE MERCADORIA RECEBIDA ANTERIORMENTE EM CONSIGNACAO MERCANTIL", 1, 0, 0, 0 ],' + ;
   '[ "1.116", "COMPRA P/ INDUSTRIALIZACAO OU PRODUCAO RURAL ORIGINADA DE ENCOMENDA P/ RECEBIMENTO FUTURO", 1, 0, 0, 0 ],' + ;
   '[ "1.117", "COMPRA P/ COMERCIALIZACAO ORIGINADA DE ENCOMENDA P/ RECEBIMENTO FUTURO", 1, 0, 0, 0 ],' + ;
   '[ "1.118", "COMPRA DE MERCADORIA P/ COMERCIALIZACAO PELO ADQUIRENTE ORIGINARIO, ENTREGUE PELO VENDEDOR REMETENTE AO DESTINATARIO, EM VENDA A ORDEM.", 1, 0, 0, 0 ],' + ;
   '[ "1.120", "COMPRA P/IND., EM VENDA A ORDEM, JA REC.DO VENDEDOR REM", 0, 0, 0, 0 ]'+ ;
   ']'

[frazato]

Bom dia!
Vou testar mais só de olhar esta muito melhor que a minha, kkkk!

Valeu obrigado!

Frazato

[JoséQuintas]

Ainda falta HASH.
No fonte que mostrou, é a parte que você está usando.

[JoséQuintas]

Esta está mais incompleta do que a anterior, não tem conversão de string.
Mas segue o estilo do fonte em C.
Basicamente a rotina retira o valor, e chama ela mesma para "sub-valores".

Código: Selecionar todos

REQUEST HB_CODEPAGE_PTISO

PROCEDURE Main

   LOCAL xValue, cTxt := TxtJson()

   Set( _SET_CODEPAGE, "PTISO" )
   SetMode( 40, 100 )

   Altd()
   xValue := ze_JsonDecode( cTxt )
   ( xValue )
   Altd()
   Inkey(0)

   RETURN

FUNCTION ze_JsonDecode( cTxt )

   LOCAL xValue

   ze_JsonDecodeValue( cTxt, @xValue )

   RETURN xValue

FUNCTION ze_JsonDecodeValue( cTxt, xValue )

   LOCAL xValue2

   DO WHILE Len( cTxt ) > 0
      DO WHILE Left( cTxt, 1 ) $ " ," + Chr(13) + Chr(10) .AND. Len( cTxt ) > 0
         cTxt := Substr( cTxt, 2 )
      ENDDO
      DO CASE
      CASE Left( cTxt, 1 ) $ "]}"
         RETURN .F.
      CASE Left( cTxt, 1 ) == "["
         xValue := {}
         cTxt := Substr( cTxt, 2 )
         DO WHILE ze_JsonDecodeValue( @cTxt, @xValue2 )
            AAdd( xValue, xValue2 )
            xValue2 := Nil
         ENDDO
         RETURN .T.
      CASE Left( cTxt, 1 ) == "{"
         xValue := hb_Hash()
         cTxt := Substr( cTxt, 2 )
         DO WHILE ze_JsonDecodeValue( @cTxt, @xValue2 )
            AAdd( xValue, xValue2 )
            xValue2 := Nil
         ENDDO
         RETURN .T.
      CASE Left( cTxt, 1 ) $ "-123456789"
         xValue := ""
         DO WHILE Left( cTxt, 1 ) $ "-0123456789." .AND. Len( cTxt ) > 0
            xValue += Left( cTxt, 1 )
            cTxt := Substr( cTxt, 2 )
         ENDDO
         xValue := Val( xValue )
         RETURN .T.
      CASE Left( cTxt, 5 ) == "false"
         xValue := .F.
         cTxt := Substr( cTxt, 6 )
         RETURN .T.
      CASE Left( cTxt, 4 ) == "null"
         xValue := Nil
         cTxt := Substr( cTxt, 5 )
         RETURN .T.
      CASE Left( cTxt, 4 ) == "true"
         xValue := .T.
         cTxt := Substr( cTxt, 5 )
         RETURN .T.
      CASE .T.
        cTxt := Substr( cTxt, 2 )
      CASE Left( cTxt, 1 ) == ["]
         // pode ser string ou item hash
      ENDCASE
   ENDDO

   RETURN .F.

FUNCTION txtJson()

   RETURN "[ 123, false, true, null, [ 1, 2, 3 ] ]"

Explicação:

- Se encontra "[", significa que está iniciando um valor array, então pega até "]" pra encerrar o array
- Se encontra "{", significa que está iniciando um valor hash, então pega até "}" pra encerrar o hash
- Se tem 0 a 9 ou -, significa que está iniciando um número, então pega enquanto tem número
- Se tem null, false ou true, é isso que usa

Se no elemento do array encontrar "[", começa um array que será um sub-array

Falta string e hash, porque nos dois casos usa uma string entre aspas, então não pode fazer uma sem a outra.

O legal é que ao resolver, vai resolver qualquer situação, tudo junto e misturado.

Lembrando: uma string com aspas, vai usar o \", igual SQL, isso tem na rotina em C.

Por exemplo: Jose "Quintas", isso no json vai ser "Jose \"Quintas\""

Olhando com atenção a rotina tem C tem tudo isso, um grande CASE/SWITCH pras várias possibilidades.
Parece que também tem pra aspas simples, talvez string no json possa ser com aspas simples e duplas.

[JoséQuintas]

Alteração no esquema, talvez mais próximo do fonte em C.

Código: Selecionar todos

REQUEST HB_CODEPAGE_PTISO

PROCEDURE Main

   LOCAL xValue, cTxt := TxtJson()

   Set( _SET_CODEPAGE, "PTISO" )
   SetMode( 40, 100 )

   Altd()
   xValue := ze_JsonDecode( cTxt )
   ( xValue )
   Altd()
   Inkey(0)

   RETURN

FUNCTION ze_JsonDecode( cTxt )

   LOCAL xValue

   ze_JsonDecodeValue( cTxt, @xValue )

   RETURN xValue

FUNCTION ze_JsonDecodeValue( cTxt, xValue )

   LOCAL xValue2, lReturn := .F.

   DO WHILE Len( cTxt ) > 0
      DO WHILE Left( cTxt, 1 ) $ " " + Chr(13) + Chr(10) .AND. Len( cTxt ) > 0
         cTxt := Substr( cTxt, 2 )
      ENDDO
      DO CASE
      CASE Left( cTxt, 1 ) $ "]}"
         lReturn := .F.
         cTxt := Substr( cTxt, 2 )
         EXIT
      CASE Left( cTxt, 1 ) == "["
         xValue := {}
         cTxt := Substr( cTxt, 2 )
         DO WHILE ze_JsonDecodeValue( @cTxt, @xValue2 )
            AAdd( xValue, xValue2 )
            xValue2 := Nil
         ENDDO
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 1 ) == "{"
         xValue := hb_Hash()
         cTxt := Substr( cTxt, 2 )
         DO WHILE ze_JsonDecodeValue( @cTxt, @xValue2 )
            AAdd( xValue, xValue2 )
            xValue2 := Nil
         ENDDO
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 1 ) $ "-123456789"
         xValue := ""
         DO WHILE Left( cTxt, 1 ) $ "-0123456789." .AND. Len( cTxt ) > 0
            xValue += Left( cTxt, 1 )
            cTxt := Substr( cTxt, 2 )
         ENDDO
         xValue := Val( xValue )
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 5 ) == "false"
         xValue := .F.
         cTxt := Substr( cTxt, 6 )
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 4 ) == "null"
         xValue := Nil
         cTxt := Substr( cTxt, 5 )
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 4 ) == "true"
         xValue := .T.
         cTxt := Substr( cTxt, 5 )
         lReturn := .T.
         EXIT
      CASE Left( cTxt, 1 ) == ["]
         // pode ser string ou item hash
         xValue2 := ""
         cTxt := Substr( cTxt, 2 )
         DO WHILE Len( cTxt ) > 0
            DO CASE
            CASE Left( cTxt, 2 ) == [\"]
               xValue2 += ["]
               cTxt := Substr( cTxt, 3 )
               LOOP
            CASE Left( cTxt, 2 ) == [\']
               xValue2 += [']
               cTxt := Substr( cTxt, 3 )
               LOOP
            ENDCASE
            IF Left( cTxt, 1 ) == ["]
               cTxt := Substr( cTxt, 2 )
               EXIT
            ENDIF
            xValue2 += Left( cTxt, 1 )
            cTxt := Substr( cTxt, 2 )
         ENDDO
         IF Left( cTxt, 1 ) == ":"
            xValue := hb_Hash()
            cTxt := Substr( cTxt, 2 )
            ze_JsonDecodeValue( @cTxt, @xValue[ xValue2 ] )
            lReturn := .T.
            EXIT
         ELSE
            xValue := xValue2
            lReturn := .T.
            EXIT
         ENDIF
      ENDCASE
      cTxt := Substr( cTxt, 2 )
   ENDDO
   DO WHILE Left( cTxt, 1 ) $ ", " + Chr(13) + Chr(10) .AND. Len( cTxt ) > 0
      cTxt := Substr( cTxt, 2 )
   ENDDO

   RETURN lReturn

FUNCTION txtJson()

   RETURN "[ 123, false, true, null, " + Chr(34) + "testando" + Chr(34) + ", [ 1, 2, 3 ], [ [ 1, 2 ] ] ]"

Agora funcionou decodificar esta:

Código: Selecionar todos

   "[ 123, false, true, null, " + Chr(34) + "testando" + Chr(34) + ", [ 1, 2, 3 ], [ [ 1, 2 ] ] ]"

array com sub-array, em 2 níveis

Sem acompanhar com debug seria complicado.
Mas não me refiro pra ver o resultado acima, mas sim acompanhar letra por letra.