PC Toledo

Código: Selecionar todos

#include "FiveWin.ch"

//----------------------------------------------------------------//
function Main()

   LOCAL cTexte := "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   LOCAL cTXTOriginal := "" + ;
         "Obs: venda de Substituição tributária para consumidor final não incide ICMS. Ressalto ainda que existem algumas confusões em relação a Substituto tributário e Substituido tributário, vocês precisam verificar em que condição a empresa de vocês se encaixam, se é substituto tributário ou substituido e acompanhar os produtos da tabela no link acima, onde nossa amiga postou." + ;
         "EX: Substituto Tributário = Fabricante/Importador (aquele que industrializa, e também é o que retem o ICMS) destacando na NF a base de calculo do ICMS retido por Substituição Trib. e ICMS retido por substituição Trib." + ;
         "Substituido Tributário= quem compra e revende (aquele que compra, recebe a mercadoria não retem o ICMS) somente repassa o valor do ICMS retido por Substituição que consta da NF de compra, destacando em sua NF de venda em dados adicionais, isso se a venda for feita para pessoas juridicas, caso seja venda para pessoa fisica (consumidor final) não há necessidade de destacar esse valor de ICMS retido por Substituição. Caso a venda seja feita fora do estado terá que emitir uma nota de venda normal com CFOP 6102 e com destaque de icms." + ;
         "" + ;
         "Aí vão algumas dicas importantes:" + ;
         "Para itens sujeitos a substituição tributária (CST 60 e CSOSN 500), o aplicativo comercial necessita estar preparado para informar o código CEST;" + ;
         "O código token e seu respectivo id (CSC e CSC ID) devem ser válidos ou seja, o contribuinte necessita obter estes códigos diretamente com a SEFAZ do seu estado. Lembrando que o código token é uma das informações que compõe a string do QR-Code no XML NFC-e, e se informado de forma indevida, haverá possível rejeição do XML junto a SEFAZ do estado." + ;
         "*A string do QR-Code, é montada de forma automática pelo cliente Fiscal Manager." + ;
         "Para pagamentos relacionados a transação de débito e crédito, a aplicação necessita estar preparada para informar os seguintes dados:" + ;
         "CNPJ do credenciador do Cartão;" + ;
         "Código referente a bandeira da operadora;" + ;
         "Código de autorização da operação de crédito e débito;" + ;
         "Tipo de integração do sistema de vendas (integrado com o TEF ou POS)." + ;
         "*Fica a critério de cada UF, a obrigatoriedade ou não da exigência dessas informações." + ;
         "O código NCM informado para cada produto de venda, deve estar de acordo com a tabela divulgada pelo Ministério do Desenvolvimento (MDIC);" + ;
         "A consistência dos códigos CST x CFOP e CSOSN x CFOP, devem estar de acordo com as orientações da NT 2015/002, exemplos:" + ;
         "Para CST 60, informar os valores CFOP: 5.405 ou 5.656 ou 5.667." + ;
         "Para valores de CST 00, 20, 40, 41, ou 90, informar os seguintes valores de CFOP são permitidos: 5.101 ou 5.102 ou 5.103 ou 5.104 ou 5.115." + ;
         "Para CSOSN 500, informar: 5.405 ou 5.656 ou 5.667. " + ;
         "*Maiores detalhes, podem ser consultados na documentação da Normativa Técnica 2015/002." + ;
         "A utilização dos códigos CFOP 5.401 e 5.403, relacionados ao regime de substituição tributária, e o código CFOP 5.653, relacionado com a venda de combustível de produção do estabelecimento para consumidor final, foram eliminados;" + ;
         "Para vendas de combustíveis, a aplicação comercial necessita estar preparada para informar dados do encerrante, sendo a exigência desses dados a critério da UF."

   ? "HB_BASE64DECODE",,HB_BASE64DECODE( StrToBase64( cTXTOriginal ) )

   cBase64 := StrToBase64( "xOraClip" )

   ? cBase64,"Result: eEhhcmJvdXI=="                     // result: eEhhcmJvdXI==

   ? HB_Base64Decode( cBase64 ),"Result: xOraClip"

   // Nao consegui resultado aqui
   ? "Crypt"      , Crypt( cTXTOriginal, "rochinha" )                                   // Crypt(<cString>,<cPassWord>)->cResult
   ? "DeCrypt"    , DeCrypt( Crypt( cTXTOriginal, "rochinha" ), "rochinha" )            // DeCrypt(<cString>,<cPassWord>)->cResult
   
   // Aqui funcionou pra caramba
   ? "SX_Encrypt" , SX_Encrypt( cTXTOriginal, "rochinha" )                              // SX_Encrypt(<cString>,<Password>)->cEncryptedString
   ? "SX_Decrypt" , SX_Decrypt( SX_Encrypt( cTXTOriginal, "rochinha" ), "rochinha" )    // SX_Decrypt(<cString>,<Password>)->cEncryptedString

   // Nao tive resultado nas 4 linhas a seguir
   //   ? "Hash"       , Hash( "Nome", "Rochinha" )                                        // Hash([<xKey1>,<xValue1>,[<xKeyN>,<xValueN>]])->hHash 
   //   ? "HB_Compress", HB_Compress( cTXTOriginal )                                       // HB_Compress(<cString>)->cCompressed
   //   ? "HB_Crypt"   , HB_Crypt( "Nome", "Rochinha" )                                    // HB_Crypt(<cString>,<cKey>)->cEncryptedString
   //   ? "HB_Decrypt" , HB_Decrypt( HB_Crypt( "Nome", "Rochinha" ), "Rochinha" )          // HB_Decrypt(<cEncryptedString>,<cKey>)->cString

   /* OK */ ?"sx_Compress",,cTXTOriginal,,sx_Compress( cTXTOriginal )

   /* OK */ ?"sx_Compress/sx_DeCompress",,cTXTOriginal,,sx_DeCompress( sx_Compress( cTXTOriginal ) )

   /* OK */ ? "Teste StrToBase64",,StrToBase64( cTexte ),, Base64ToStr( StrToBase64( cTexte ) ),, Base64ToStrError( StrToBase64( cTexte ) )

   /* OK */ ? "Teste Base64ToStr",,Base64ToStr( StrToBase64( cTXTOriginal ) ),, Base64ToStrError( StrToBase64( cTXTOriginal ) )
   
   ? "Teste 2",,Ascii2UTF8( cTXTOriginal ),,UTF82Ascii( Ascii2UTF8( cTXTOriginal ) ),,UTF82Ascii( cTXTOriginal )
   //? "Teste 3",,pack_h32( StrToBase64( cTXTOriginal ) )
   //? "Teste 4",,pack_h32( cTXTOriginal )

return nil

FUNCTION sx_Compress( xVal )
   LOCAL xRetVal
   DO CASE
      CASE ValType( xVal ) = "C" .or. ValType( xVal ) = "M"
           RETURN _sx_StrCompress( xVal )
      CASE ValType( xVal ) = "A"
           xRetVal := Array( Len( xVal ) )
           AEval( xVal, {| x, i | xRetVal[ i ] := sx_Compress( x ) } )
           RETURN xRetVal
   ENDCASE 
   RETURN xVal

FUNCTION sx_Decompress( xVal )
   LOCAL xRetVal
   DO CASE
      CASE ValType( xVal ) = "C" .or. ValType( xVal ) = "M"
           RETURN _sx_StrDecompress( xVal )
      CASE ValType( xVal ) = "A"
           xRetVal := Array( Len( xVal ) )
           AEval( xVal, {| x, i | xRetVal[ i ] := sx_Decompress( x ) } )
           RETURN xRetVal
   ENDCASE
   RETURN xVal
   
FUNCTION StrToBase64( cTexte )
   *******************
   * Conversion en base 64 de la chaine cTexte
   * Un alphabet de 65 caractères est utilisé pour permettre la représentation de 6 bits par caractère :
   * "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   * Le '=' (65e caractère) est utilisé dans le processus de codage pour les caractères finaux.
   LOCAL cTexte64 := ""
   LOCAL X
   LOCAL cHex
   DO WHILE !( cTexte == "" )
      cHex := ""
      * Le processus de codage représente des groupes de 24 bits de données en entrée par une chaîne en sortie de 4 caractères codés.
      * En procédant de gauche à droite, un groupe de 24 bits est créé en concaténant 3 octets (8 bits par octet).
      FOR X := 1 TO 3
          * Conversion de chaque caractère en chaine binaire de 8 octets
          cHex += CarToBin( LEFT(cTexte, 1) )
          IF LEN(cTexte) > 1
             cTexte := SUBSTR(cTexte, 2)
          ELSE
             cTexte := ""
             EXIT
          ENDIF
      NEXT X
      * Ces 24 bits (ici contenus dans cHex, ou au moins un multiple) sont traités comme 4 groupes concaténés de 6 bits chacun convertis
      * en un unique caractère dans l'alphabet de la base 64.
      * Chaque groupe de 6 bits est utilisé comme index dans la table des caractères de la base 64.
      * Le caractère référencé par l'index correspondant est utilisé comme codage de ce groupe de 6 bits.
      FOR X := 1 TO 4
          IF SUBSTR(cHex, ( (X - 1) * 6) + 1 ) == ""
             cTexte64 += REPLICATE("=", 4 - X + 1)
             EXIT
          ELSE
             * Un traitement spécial est effectué si moins de 24 bits sont disponibles à la fin des données
             * à coder. Aucun bit ne restant non-codé,
             * si moins de 24 bits sont disponibles alors des bits à zéro sont ajoutés à la droite des données
             * pour former un nombre entier de groupes de 6 bits.
             IF LEN( cHex ) % 6 > 0
                * Ajout des bits à zéro
                cHex += REPLICATE("0", 6 - ( LEN( cHex ) % 6 ) )
             ENDIF
             cTexte64 += Carac64( "00" + SUBSTR(cHex, ( (X - 1) * 6) + 1, 6 ) )
          ENDIF
      NEXT X
   ENDDO
   RETURN cTexte64

FUNCTION Base64ToStr( cTexte64 )
   *********************
   * décodage dun texte codé en base 64
   LOCAL cTexte := ""
   LOCAL X
   LOCAL cHex
   LOCAL cCar
   DO WHILE !( cTexte64 == "" )
      cCar := LEFT(cTexte64,4)
      cHex := ""
      FOR X := 1 TO 4 
          IF SUBSTR(cCar, X, 1 ) != "="
             cHex += Hex64( SUBSTR(cCar, X, 1 ) )
          ELSE
             EXIT
          ENDIF 
      NEXT X
      FOR X := 1 TO 3
          IF SUBSTR(cHex, ( (X - 1) * 8)  + 1 ) == ""
             EXIT
          ELSE
             cTexte += BinToCar( SUBSTR(cHex, ( (X - 1) * 8)  + 1, 8 ) )
          ENDIF
      NEXT X
      IF LEN(cTexte64) > 4
         cTexte64 := SUBSTR(cTexte64, 5)
      ELSE
         cTexte64 := ""
      ENDIF
   ENDDO
   RETURN cTexte

FUNCTION Base64ToStrError( cTexte64 )
   LOCAL cTexte := ""
   LOCAL X
   LOCAL cHex
   LOCAL cCar
   DO WHILE !( cTexte64 == "" )
      cCar := LEFT(cTexte64,4)
      cHex := ""
      FOR X := 1 TO 4
          IF SUBSTR(cCar, X, 1 ) != "="
             cHex += Hex64( SUBSTR(cCar, X, 1 ) )
          ELSE
             EXIT
          ENDIF
      NEXT X
      FOR X := 1 TO 3
          IF SUBSTR(cHex, ( (X - 1) * 8) + 1 ) == ""
             EXIT
          ELSE
             cTexte += BinToCar( SUBSTR(cHex, ( (X - 1) * 8) + 1, 8 ) )
          ENDIF
      NEXT X
      IF LEN(cTexte64) > 4
         cTexte64 := SUBSTR(cTexte64, 5)
      ELSE
         cTexte64 := ""
      ENDIF
   ENDDO
   //The function Base64toStr, has a error, the change is, add this code on the end function:
   cTexte := str2hex(cTexte)
   IF Right(cTexte,2)="00"
      cTexte := SubStr(cTexte,1,len(cTexte)-2)
   ENDIF
   cTexte := Hex2Str(cTexte)
   RETURN cTexte
   
FUNCTION Carac64( cBin )
   ****************
   * Renvoie le caractère correspondant en base 64
   LOCAL nPos := ASC( BinToCar( @cBin ) ) + 1
   RETURN SUBSTR( "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", nPos, 1)

FUNCTION Hex64( carac64 )
   **************
   * Renvoie le caractère correspondant en base 64
   LOCAL cCodeAsc := CHR( AT(carac64, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ) -1 )
   RETURN SUBSTR( CarToBin( @cCodeAsc ) , 3, 6)

FUNCTION CarToBin( carac, lInverse )
   *****************
   * Renvoie le caractère correspondant dans une chaine binaire (composée de 0 et 1) de 8 bits
   #define cHexa "0123456789ABCDEF"
   #define aBin {"0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", "1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111" }
   LOCAL cToHex
   IF EMPTY( lInverse )
      * Retourne la chaine binaire en ayant reçu le caractère ASCII
      cToHex := str2Hex( carac )
      RETURN aBin[ AT( LEFT(cToHex,1), cHexa ) ] + aBin[ AT( SUBSTR(cToHex,2), cHexa ) ]
   ELSE
      * Retourne le caractère ASCII en ayant reçu la chaine binaire
      cToHex := SUBSTR(cHexa, ASCAN(aBin, LEFT(carac,4 ) ), 1 ) + SUBSTR(cHexa, ASCAN(aBin, SUBSTR(carac,5,4 ) ), 1 )
      RETURN Hex2str( cToHex )
   ENDIF
   RETURN NIL

FUNCTION BinToCar( cBin )
   *****************
   RETURN CarToBin( @cBin, .T. )

FUNCTION pack_h32( cString )
   local c := "1", cLeter
   local nibbleshift := 4
   local n
   local nPos   := 0
   local aOut   := {}
   for each cLeter in cString
       n = asc( cLeter )
       if n >= asc( "0" ) .and. n <= asc( "9" )
          n -= asc( "0" )
       elseif n >= asc( "a" ) .and. n <= asc( "f" )
          n -= ( asc( "a" ) - 10 )
       elseif n >= asc( "F" ) .and. n <= asc( "F" )
          n -= ( asc( "A" ) - 10 )
       endif
       if cLeter:__enumindex() % 2 != 0
          AAdd( aOut, 0 )
          nPos++
       endif
       aOut[ nPos ] = hb_BitOr( aOut[ nPos ], hb_BitShift( n, nibbleshift ) )
       nibbleshift = hb_BitAnd( ( nibbleshift + 4 ), 7 )
       if cLeter:__enumindex() % 2 == 0
          c += Chr( aOut[ nPos ] )
       endif
   next
   RETURN c
   
// --------------------------------------
FUNCTION Ascii2UTF8( pcString ) 
   LOCAL cBuff, c, i, h, l 
   cBuff := "" 
   FOR i = 1 TO LEN(pcString) 
       c := ASC(SUBS(pcString,i,1)) 
       IF c < 128 
          cBuff := cBuff + CHR(c)  
       ELSE
          h := hb_BitOr(hb_BitRShift(c,6),0xC0) // hb_bitOr( BitRShift(c,6),0xC0 )   
          // Function similar to "BitRShift()" in harbour ?? 
          l := hb_BitOr(hb_BitAnd(c,0x3F),0x80) // hb_BITOR( hb_BITAND(c,0x3F),0x80) 
          cBuff := cBuff + CHR(h) + CHR(l) 
       ENDIF 
   NEXT
   RETURN cBuff   

*   Basado en informacion de wikipedia: 
*   http://en.wikipedia.org/wiki/UTF-8 
* 
FUNCTION UTF82Ascii( pcString )
   LOCAL cBuff, i, nAsc, c
   nAsc := 0 
   cBuff := "" 
   FOR i = 1 TO LEN(pcString) 
       * 
       c := ASC(SUBS(pcString,i,1)) 
       IF c < 128 
          IF nAsc > 0 
             cBuff := cBuff + CHR(nAsc) 
             nAsc := 0 
          ENDIF 
          cBuff := cBuff + CHR(c) 
       ELSE 
          IF hb_BitTest(c,6) 
             nSize := hb_BitRShift(hb_BitAnd(c,0x60),5)             // ?? 
             nAsc := hb_BitLShift(hb_BitClear(hb_BitClear(c,7),6),6 * (nSize - 1)) // ?? 
          ELSE 
             nAsc := hb_BitOr(nAsc, hb_BitClear(hb_BitClear(c,7),6))    // 
          ENDIF 
       ENDIF 
       * 
   NEXT 
   RETURN cBuff

// --------------------------------------
#pragma BEGINDUMP

#include <hbapi.h>

HB_FUNC( STRREV )
{
   int iLen = hb_parclen( 1 ), i;
   char * buffer = ( char * ) hb_xgrab( iLen );

   for( i = 0; i < iLen; i++ )
      buffer[ i ] = hb_parc( 1 )[ iLen - i - 1 ];

   hb_retclen( buffer, iLen );
   hb_xfree( buffer );
}

#pragma ENDDUMP

// --------------------------------------
#pragma BEGINDUMP
/*
 * $Id: hbbit.c 8681 2008-06-10 09:13:33Z vszakats $
 */
#include "hbapi.h"
#include "hbapierr.h"

#define HB_ERR_ARGS_BASEPARAMS          0xFFFFFFFF
#define HB_ERR_ARGS_SELFPARAMS          0xFFFFFFFE

#define HB_ERR_FUNCNAME                 ( ( const char * ) ( HB_PTRDIFF ) 1 )

#define BitSet(reg,bitnum)   (reg |= ~(1 << bitnum) )
#define BitClear(reg,bitnum) (reg &= ~(1 << bitnum) )

/* NOTE: IMPORTANT:
         hb_bit*() Harbour level function names and logic are embedded 
         in the compiler optimization engine, so in any case these 
         function have to be changed, updated or extended, don't forget 
         to update the references in the compiler as well.
         [vszakats] */

static BOOL hb_numParam( int iParam, HB_LONG * plNum )
{
   if( ISNUM( iParam ) )
   {
      *plNum = hb_parnint( iParam );
      return TRUE;
   }
   hb_errRT_BASE_SubstR( EG_ARG, 1089, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
   *plNum = 0;
   return FALSE;
}

HB_FUNC( HB_BITAND )
{
   HB_LONG lValue;
   if( hb_numParam( 1, &lValue ) )
   {
      int iPCount = hb_pcount() - 1, i = 1;
      do
      {
         HB_LONG lNext;
         if( !hb_numParam( ++i, &lNext ) )
            return;
         lValue &= lNext;
      }
      while( --iPCount > 0 );
      hb_retnint( lValue );
   }
}

HB_FUNC( HB_BITOR )
{
   HB_LONG lValue;
   if( hb_numParam( 1, &lValue ) )
   {
      int iPCount = hb_pcount() - 1, i = 1;
      do
      {
         HB_LONG lNext;
         if( !hb_numParam( ++i, &lNext ) )
            return;
         lValue |= lNext;
      }
      while( --iPCount > 0 );
      hb_retnint( lValue );
   }
}

HB_FUNC( HB_BITXOR )
{
   HB_LONG lValue;
   if( hb_numParam( 1, &lValue ) )
   {
      int iPCount = hb_pcount() - 1, i = 1;
      do
      {
         HB_LONG lNext;
         if( !hb_numParam( ++i, &lNext ) )
            return;
         lValue ^= lNext;
      }
      while( --iPCount > 0 );
      hb_retnint( lValue );
   }
}

HB_FUNC( HB_BITNOT )
{
   HB_LONG lValue;
   if( hb_numParam( 1, &lValue ) )
      hb_retnint( ~lValue );
}

HB_FUNC( HB_BITTEST )
{
   HB_LONG lValue, lBit;
   if( hb_numParam( 1, &lValue ) && hb_numParam( 2, &lBit ) )
      hb_retl( ( lValue & ( ( HB_LONG ) 1 << lBit ) ) != 0 );
}

HB_FUNC( HB_BITSET )
{
   HB_LONG lValue, lBit;
   if( hb_numParam( 1, &lValue ) && hb_numParam( 2, &lBit ) )
      hb_retnint( lValue | ( ( HB_LONG ) 1 << lBit ) );
}

HB_FUNC( HB_BITRESET )
{
   HB_LONG lValue, lBit;
   if( hb_numParam( 1, &lValue ) && hb_numParam( 2, &lBit ) )
      hb_retnint( lValue & ( ~ ( ( HB_LONG ) 1 << lBit ) ) );
}

HB_FUNC( HB_BITSHIFT )
{
   HB_LONG lValue, lBits;
   if( hb_numParam( 1, &lValue ) && hb_numParam( 2, &lBits ) )
   {
      if( lBits < 0 )
         hb_retnint( lValue >> -lBits );
      else
         hb_retnint( lValue << lBits );
   }
} 

HB_FUNC( HB_BITCLEAR ) // chutei
{
   HB_LONG lValue, lBit;
   if( hb_numParam( 1, &lValue ) && hb_numParam( 2, &lBit ) )
      hb_retnint( lValue &= ( ~ ( ( HB_LONG ) 1 << lBit ) ) );
}

// --------------------------------------
#pragma ENDDUMP

FUNCTION hb_bitRShift( x, y )
   RETURN hb_bitShift( x, -y )
   
FUNCTION hb_bitLShift( x, y ) // Chutei
   RETURN hb_bitShift( -x, y )
   
FUNCTION HB_BASE64DECODE( cString )
   LOCAL cResult

   LOCAL nLen
   LOCAL nGroupPos
   LOCAL nGroup
   LOCAL nCharPos
   LOCAL nDataLen
   LOCAL nData

   /* remove white spaces, If any */
   cString := StrTran( cString, Chr( 10 ) )
   cString := StrTran( cString, Chr( 13 ) )
   cString := StrTran( cString, Chr( 9 ) )
   cString := StrTran( cString, " " )

   /* The source must consists from groups with Len of 4 chars */
   IF ( nLen := Len( cString ) ) % 4 != 0
      RETURN "" /* Bad Base64 string */
   ENDIF

//#if 0
//    IF nLen > Int( MAXSTRINGLENGTH / 1.34 ) /* Base64 is 1/3rd larger than source text. */
//      RETURN "" /* Not enough memory to decode */
//    ENDIF
//#endif

   cResult := ""

   /* Now decode each group: */
   FOR nGroupPos := 1 TO nLen STEP 4

      /* Each data group encodes up To 3 actual bytes */
      nDataLen := 3
      nGroup := 0

      FOR nCharPos := 0 TO 3

         /* Convert each character into 6 bits of data, And add it To
            an integer For temporary storage. If a character is a '=', there
            is one fewer data byte. (There can only be a maximum of 2 '=' In
            the whole string.) */

         nData := At( SubStr( cString, nGroupPos + nCharPos, 1 ), "=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ) - 2

         DO CASE
         CASE nData >= 0
            /* Do nothing (for speed) */
         CASE nData == -1
            nData := 0
            nDataLen--
         CASE nData == -2
            RETURN "" /* Bad character In Base64 string */
         ENDCASE

         nGroup := 64 * nGroup + nData
      NEXT

      /* Convert the 24 bits to 3 characters
         and add nDataLen characters To out string */
      cResult += Left( Chr( nGroup / 65536 ) +;         
                       Chr( nGroup /   256 ) +;         
                       Chr( nGroup         ), nDataLen )
   NEXT

   RETURN cResult