Clipper On Line • Ver Tópico - compressão/des-compressão de string e texto de/para Base64

compressão/des-compressão de string e texto de/para Base64

Discussão sobre a biblioteca Fivewin - O Clipper para Windows.

Moderador: Moderadores

 

compressão/des-compressão de string e texto de/para Base64

Mensagempor rochinha » 29 Jun 2018 07:38

Amiguinhos,

Segue meus testes para fazer compressão de strings. De uma forma bem simples podemos esquecer os campos Memo e comprimir largas strings em conteúdos pequenos para campos caracter.

Obs: não testei o salvamento em campos do conteúdo compresso.

Também tem um teste de transformação de texto básico para texto em Base64 e Vice-versa.

Estes métodos podem ser usados para tratamento de textos que devam ser enviados por qualquer meio, ip, email, sms, etc e exijam uma certa segurança.
Segue o código:
#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."

   // Comprime texto longo
   ?"sx_Compress",,cTXTOriginal,,sx_Compress( cTXTOriginal )
   
   // Descomprime texto compactado
   ?"sx_Compress",,cTXTOriginal,,sx_DeCompress( sx_Compress( cTXTOriginal ) )
   
   // Transforma textos em Base64
   ? "Teste 1",,StrToBase64( cTexte ),, Base64ToStr( StrToBase64( cTexte ) ),, Base64ToStrError( StrToBase64( cTexte ) )
   
   // Converte texto Base64 em texto puro   
   ? "Teste 2",,Base64ToStr( StrToBase64( cTXTOriginal ) ),, Base64ToStrError( StrToBase64( 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. )


Se faltar alguma função é só perguntar. É tudo Harbour e a HBSIX é necessária.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4187
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 482 vezes
Mens.Curtidas: 181 vezes



Retornar para FiveWin

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 1 visitante


Faça uma doação para o forum
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro