Base64 codificar e descodificar?

kapiaba · February 29, 2016

Transformar dados na base64 para ascII

Base64 codificar e descodificar

Base64 Decode and Encode

http://www.hcidata.info/base64.htm

Personas, alguém pode me explicar para que serve isso e se é possível fazer isso em xHarbour?

Exemplos?

Obg. abs

kapiaba · February 29, 2016

Esta função, é do Harbour ou xHarbour?

   memowrit( 'image.jpg', hb_base64Decode( cData ) )

kapiaba · February 29, 2016



/*
http://forums.fivetechsupport.com/viewtopic.php?f=6&t=25690&p=140507&hilit=BASE64#p140507


Esta me funciona a mi excelente


Pones una variable


cXml := Base64toStr(oNodo:CData)



y aca el codigo

*/



// otras

* BASE64.PRG

* Creation le 30/12/2008

* Auteur Badara Thiam

* Derniere modification le 25/09/2009 à 16:35:37


* Modification du 25/09/2009 effectuée dans StrToBase64()

* Résout une erreur de conversion apparaissant lorsque :

* ( le nombre de caractères dans la chaine multiplié par 8) n'est pas un multiple de 6


*******************

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 d'un texte codé en base 64

LOCAL cTexte := ""

LOCAL X

LOCAL cHex

LOCAL cCar

DO WHILE !( cTexte64 == "" )

try 

cCar := LEFT(cTexte64,4)

catch

end

cHex := ""

try 

FOR X := 1 TO 4 

IF SUBSTR(cCar, X, 1 ) != "="

cHex += Hex64( SUBSTR(cCar, X, 1 ) )

ELSE

EXIT

ENDIF 

NEXT X

catch

end


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 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. )

Isto é em HARBOUR e em xHarbour, será que existe?

kapiaba · February 29, 2016



**************************************************

* xhbenc.prg - C:\XHARBOUR\TESTS

* $Id: xhbenc.prg 9293 2011-02-14 21:57:14Z andijahja $

* Test program for file encoding and decoding

* UUEncode, Base64, YYEncode and XXEncode

*

* Andi Jahja

*

* Must link hbcc.lib

//----------------------------------------------------------------------------//


#include "directry.ch"

#include "box.ch"

#include "inkey.ch"


static aOkey := { " Continue " , " Quit " }

static cScr


PROCEDURE MAIN()


   LOCAL nError

   LOCAL nFault := 0

   LOCAL nStart

   LOCAL nOldRow := Row(), nOldCol := Col()

   cScr := savescreen(0,0,maxrow(),maxcol())


   BEGIN SEQUENCE


   SET CURSOR OFF

   CLEAR SCREEN


   IF !File( "pp.prg" )

      __CopyFile( "..\utils\xbscript\xbscript.prg", "pp.prg" )

   ENDIF


   IF Alert( "xHarbour File Encoding Tests", aOkey, "N/W*" ) == 2

      _QuitMe()

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Will UUEncode pp.prg to ~pp.uue.;Syntax: UUENCODE_FILE( "pp.prg", "~pp.uue" )',aOkey,"N/GR*" ) == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := UUENCODE_FILE( "pp.prg", "~pp.uue" ) ) == 0 .AND. File( "~pp.uue" )

      ShowResult( "~pp.uue", "UUE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Now will Base64_Encode pp.prg to ~pp.b64.;Syntax: B64ENCODE_FILE( "pp.prg", "~pp.b64" )',aOkey, "N/BG*" ) == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := B64ENCODE_FILE( "pp.prg", "~pp.b64" ) ) == 0 .AND. File( "~pp.b64" )

      ShowResult( "~pp.b64", "B64", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Will YYEncode pp.prg to ~pp.yye.;Syntax: YYENCODE_FILE( "pp.prg", "~pp.yye" )',aOkey,"N/GR*" ) == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := YYENCODE_FILE( "pp.prg", "~pp.yye" ) ) == 0 .AND. File( "~pp.yye" )

      ShowResult( "~pp.yye", "YYE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Will XXEncode pp.prg to ~pp.xxe.;Syntax: XXENCODE_FILE( "pp.prg", "~pp.xxe" )',aOkey,"W+/BG" ) == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := XXENCODE_FILE( "pp.prg", "~pp.xxe" ) ) == 0 .AND. File( "~pp.xxe" )

      ShowResult( "~pp.xxe", "XXE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF ALert( 'Now Will UUEncode pp.prg to ~pp*.uue;with 2000 lines per chunk.;Syntax: UUENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" )',aOkey, "W+/B" ) == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := UUENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" ) ) == 0

      ShowResult( "~pp*.uue", "UUE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Now Will Base64_Encode pp.prg to ~pp*.b64;with 2000 lines per chunk.;Syntax: B64ENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" )',aOkey,"W+/G") == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := B64ENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" ) ) == 0

      ShowResult( "~pp*.b64", "B64", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Now Will YYEncode pp.prg to ~pp*.yye;with 1000 lines per chunk.;Syntax: YYENCODE_FILE_BY_CHUNK( "pp.prg", 1000, "~pp" )',aOkey,"W+/N") == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := YYENCODE_FILE_BY_CHUNK( "pp.prg", 1000, "~pp" ) ) == 0

      ShowResult( "~pp*.yye", "YYE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   IF Alert( 'Now Will XXEncode pp.prg to ~pp*.xxe;with 2000 lines per chunk.;Syntax: XXENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" )',aOkey,"N/BG*") == 2

      _QuitMe()

   ENDIF


   nStart := seconds()

   IF ( nError := XXENCODE_FILE_BY_CHUNK( "pp.prg", 2000, "~pp" ) ) == 0

      ShowResult( "~pp*.xxe", "XXE", nStart )

   ELSE

      ShowError( @nFault, nError )

   ENDIF


   CLEAR SCREEN

   Alert( "File Encoding Tests Completed" + if(nFault>0,". Error encountered : " + ltrim(str(nFault)),". All tests succesfull!"), { " Bye "},"N/W*" )


   END SEQUENCE


   restscreen(0,0,maxrow(),maxcol(),cScr)

   SET CURSOR ON

   SetPos( nOldRow, nOldCol )


   RETURN


//----------------------------------------------------------------------------//

STATIC PROCEDURE ShowResult( cFileMask, cEncoding, nStart )


   LOCAL aFiles, aItem

   LOCAL nDecoded := 0

   LOCAL cSyntax

   LOCAL aDecodedFiles := {}

   LOCAL iChoice


   IF !Empty( aFiles := Directory( cFileMask ) )

      Alert( "Conversion succesful !;Done in " + ltrim(str(seconds()-nStart)) + " seconds", { " Okay " }, "N/W*" )


      AEval( aFiles, { |e| AADD( aDecodedFiles, e[1] ) } )


      FOR EACH aItem IN aFiles

         View( aItem )

      NEXT


      CLEAR SCREEN


      DO CASE

      CASE cEncoding == "UUE"

         cSyntax  := 'UUDECODE_FILE( aDecodedFiles, "result.txt" )'

         IF Alert( "Now will decode the encoded files to 'result.txt';Syntax : " + cSyntax , aOkey, "gr+/b" ) == 2

            _QuitMe()

         ENDIF

         ? "Decoding in progress ......"

         nStart := seconds()

         nDecoded := UUDECODE_FILE( aDecodedFiles, "result.txt" )

      CASE cEncoding == "B64"

         cSyntax  := 'B64DECODE_FILE( aDecodedFiles, "result.txt" )'

         IF Alert( "Now will decode the encoded files to 'result.txt';Syntax : " + cSyntax , aOkey, "gr+/b" ) == 2

            _QuitMe()

         ENDIF

         ? "Decoding in progress ......"

         nStart := seconds()

         nDecoded := B64DECODE_FILE( aDecodedFiles, "result.txt" )

      CASE cEncoding == "YYE"

         cSyntax  := 'YYDECODE_FILE( aDecodedFiles, "result.txt" )'

         IF Alert( "Now will decode the encoded files to 'result.txt';Syntax : " + cSyntax , aOkey, "gr+/b" ) == 2

            _QuitMe()

         ENDIF

         ? "Decoding in progress ......"

         nStart := seconds()

         nDecoded := YYDECODE_FILE( aDecodedFiles, "result.txt" )

      CASE cEncoding == "XXE"

         cSyntax  := 'XXDECODE_FILE( aDecodedFiles, "result.txt" )'

         IF Alert( "Now will decode the encoded files to 'result.txt';Syntax : " + cSyntax , aOkey, "gr+/b" ) == 2

            _QuitMe()

         ENDIF

         ? "Decoding in progress ......"

         nStart := seconds()

         nDecoded := XXDECODE_FILE( aDecodedFiles, "result.txt" )

      ENDCASE


      CLEAR SCREEN


      IF nDecoded > 0

         iChoice := Alert( "Decoding successful;Bytes written = " + ltrim(str(nDecoded)+"; Done in " + ltrim(str(seconds()-nStart))+ " seconds"),{" View ", " Skip "," Quit "},"N/W*" )

IF iChoice == 1

            IF !Empty( aDecodedFiles := Directory( "result.txt" ) )

               FOR EACH aItem IN aDecodedFiles

                  View( aItem )

               NEXT

   ENDIF

ELSEIF iChoice == 3

   _QuitMe()

ENDIF

      ELSE

         Alert( "Error in file decoding ...", { " Booo ..."})

      ENDIF


      FOR EACH aItem IN aFiles

         FErase( aItem[F_NAME] )

      NEXT

   ENDIF


   RETURN


//----------------------------------------------------------------------------//

STATIC PROCEDURE ShowError( nFault, nError )


   nFault ++

   Alert( "Error Occured. Return Code: " + ltrim(str(nError)),{" Booo ... " } )


   RETURN


//----------------------------------------------------------------------------//

STATIC PROCEDURE View( aFile )


   LOCAL o := HBEditor():New("",1,1,maxrow()-1,maxcol()-1,.F.,maxcol()-2)

   LOCAL nkey


   dispbox(0,0,maxrow(),maxcol(),B_SINGLE + ' ')

   dispoutat( 0,1, "[ " + aFile[F_NAME] + " (" + LTRIM(HB_ValToStr( aFile[F_SIZE])) + " bytes) ]" )


   o:lWordWrap := .F.

   o:Loadfile( aFile[F_NAME] )

   o:RefreshWindow()


   WHILE ( ( nKey := inkey() ) != K_ESC )

      o:MoveCursor(nKey)

   ENDDO


   RETURN


//----------------------------------------------------------------------------//

STATIC PROCEDURE _QuitMe()

   restscreen(0,0,maxrow(),maxcol(),cScr)

   BREAK

rochinha · February 29, 2016

Amiguinhos,

Interessante este apanhado de idéias. Bom documentar.

Ultimamente por causa do S@T-Fiscal estamos usando muito este recurso para transformar o resultado oriundo dos equipamentos SAT para que possamos trabalhar sobre os mesmos.

O XML resultante de resposta OK do equipamento vem formatado em Base64 e precisamos traduzir para recuperar o XML completo e assinado.

fladimir · February 29, 2016

Quando baixa xml do site do governo via webservice (baixa com certificado) Consulta NFe Destinadas vem tb criptografado ai tem q descriptografar.

rochinha · March 1, 2016

Amiguinhos

fladimir

Quando baixa xml do site do governo via webservice (baixa com certificado) Consulta NFe Destinadas vem tb criptografado ai tem q descriptografar.

Eu creio que você afirmou em seu post. Como nunca baixei nenhum XML do site do governo nem sei como eles vem. Mas interessante saber que pode ser baixado via webservice. Só não sei como.

Tenho utilizado em meus trabalhos:

                     retornoDecodificado := HB_BASE64Decode( retornoAssinado )

A função abaixo nem sei onde a encontrei e não tinha créditos portanto nem sei quem fez, mas encontrei uma outra série de funções, algumas em C que faziam o mesmo trabalho.

Mas a que me satisfêz foi:

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 ) +;          /* bitwise AND 255, which is done by Chr() automatically */
                       Chr( nGroup /   256 ) +;          /* bitwise AND 255, which is done by Chr() automatically */
                       Chr( nGroup         ), nDataLen ) /* bitwise AND 255, which is done by Chr() automatically */
   NEXT

   RETURN cResult

rochinha · March 1, 2016

Amiguinhos,

Eu estou usando o seguinte formato para des-codificar um resultado SAT-CFe:

...
                 cRespostaSAT := EnviarDadosVenda( Random( 999999 ), cSHAtivacao, MemoRead( cCFeTeste ) )
...
                  if len(cRespostaSAT) < 7
                     MsgStop( "Nenhum retorno do SAT foi encontrado. Cupom nao foi emitido." )
                     RETURN .f.                     ...

                  else
                     retornoAssinado       := cRespostaSAT[7]
                     retornoDecodificado := HB_BASE64Decode( retornoAssinado )
                     ...

fladimir · March 1, 2016

No projeto hbNFe tem um método para consultar e baixar os xmls e decodificar com esta função.

rochinha · March 1, 2016

Amiguinhos,

No projeto hbNFe tem um método para consultar e baixar os xmls e decodificar com esta função.

Boa matou 2 coelhos com uma cajadada só. Me fez lembrar onde a encontrei e onde encontrar o método de puxar os XMLs.

Valeu.

Sign In

Base64 codificar e descodificar?

Recommended Posts

kapiaba

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

rochinha

Link to comment

Share on other sites

fladimir

Link to comment

Share on other sites

rochinha

Link to comment

Share on other sites

rochinha

Link to comment

Share on other sites

fladimir

Link to comment

Share on other sites

rochinha

Link to comment

Share on other sites

Join the conversation

Browse

Activity