FiveTech Support Forums

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

#include "FiveWin.ch"

FUNCTION Main()

   LOCAL cString := "xOraClip"
   LOCAL cBase64 := HB_Base64Encode( cString, Len( cString ) )

   // xHarbour:
   ? cBase64                     // result: eEhhcmJvdXI==

   ? HB_Base64Decode( cBase64 )  // result: xOraClip

RETURN NIL

// fin

#include "hbcompat.ch"

#ifdef __XHARBOUR__

   #if defined( __PLATFORM__Windows ) .AND. !defined( __PLATFORM__WINDOWS )
      #define __PLATFORM__WINDOWS
   #endif
   #if defined( __PLATFORM__Linux ) .AND. !defined( __PLATFORM__LINUX )
      #define __PLATFORM__LINUX
   #endif

   #xtranslate hb_ScrMaxRow()              => gtInfo( HB_GTI_SCREENHEIGHT )
   #xtranslate hb_ScrMaxCol()              => gtInfo( HB_GTI_SCREENWIDTH )
   #xtranslate MaxRow(.T.)                 => gtInfo( HB_GTI_SCREENHEIGHT )
   #xtranslate MaxCol(.T.)                 => gtInfo( HB_GTI_SCREENWIDTH )

   #xtranslate hb_dbPack()                 => __dbPack()
   #xtranslate hb_dbZap()                  => __dbZap()
   #xtranslate hb_dbDrop([<x,...>])        => dbDrop(<x>)
   #xtranslate hb_dbExists([<x,...>])      => dbExists(<x>)
   #xtranslate hb_FieldLen([<x>])          => FieldLen(<x>)
   #xtranslate hb_FieldDec([<x>])          => FieldDec(<x>)
   #xtranslate hb_FieldType([<x>])         => FieldType(<x>)
....