kapiaba Posted July 4, 2018 Report Share Posted July 4, 2018 Rochinha, podeis explicar para que serve e a finalidade dessa função, porfa? // compressão/des-compressão de string e texto de/para Base64 // http://www.pctoledo.com.br/forum/viewtopic.php?f=2&t=19287 // É tudo Harbour e a HBSIX é necessária. #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. ) Quote Link to comment Share on other sites More sharing options...
rochinha Posted July 4, 2018 Report Share Posted July 4, 2018 Amiguinhos, As funções do teste exemplificado deram resultado a uma necessidade minha que porventura pode ser usado e implementado por qualquer um. A minha necessidade era a de transportar conteúdo de uma forma mais segura, criptografia, de um ponto a outro, ou seja, entre empresas. Mas também a de armazenamento dentro de tabelas .DBF. Exemplo, uso no SAT. O cupom é recolhido dos equipamento em Base64 e temos que converte-los para imprimir, etc. Mas eu queria fazer tudo isto em memória e depois salvar, mesmo em Base64 em um campo simples, caracter, nas tabelas de venda. Mas o tamanho poderia ser impecilho, pois o máximo de um campo poderia ser ultrapassado e não queria usar arquivos acessórios como DBF/FPT. Neste caso as funções de compactação e descompactação de strings serviriam para comprimir longos textos e salvar em campos caracter. A vontade de programadores de salvar longos textos ou até imagens em tabelas .DBF pode ser resolvido com a compactação, diminuindo o numero de arquivos externos a aplicação. O teste acima não é específico, mas mostra as utilidades conjuntas para efeito de base de conhecimento. Um dia você poderá precisar. Como diz o Bradesco: "...é melhor ter... Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.