Base64 natives functions in Clipper !

Base64 natives functions in Clipper !

Postby Badara Thiam » Wed Feb 04, 2009 3:09 pm

Hello,

I put here in public domain, for Clipper and [x]Harbour developpers,
some functions i have created to translate strings in Base64 encodage
and reverse. This will help you in some cases, like to create your own
TSMTP class with Autentification support, necessary to communicate
with more in more SMTP providers...

To help me, you can if this please you, and if you have a web site,
put a link to my site to improve my google ratio. Thanks in advance.

Best Regards.

Code: Select all  Expand view
* BASE64.PRG
* Creation le 30/12/2008
* Auteur Badara Thiam

*******************
FUNCTION StrToBase64( cTexte )
*******************
* Conversion en base 64 de la chaine cTexte
LOCAL cTexte64 := ""
LOCAL X
LOCAL cHex
DO WHILE !( cTexte == "" )
  cHex := ""
  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
  FOR X := 1 TO 4
    IF SUBSTR(cHex, ( (X - 1) * 6) + 1 ) == ""
      cTexte64 += "="
    ELSE
      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 == "" )
  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 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. )
Badara Thiam
http://www.icim.fr
User avatar
Badara Thiam
 
Posts: 160
Joined: Tue Oct 18, 2005 10:21 am
Location: France

Re: Base64 natives functions in Clipper !

Postby vailtom » Tue Sep 08, 2009 4:43 pm

Thank you for your contribution! This helped me today in a project ...

Regards
Vailton Renato
User avatar
vailtom
 
Posts: 47
Joined: Thu Jan 05, 2006 6:56 pm

Re: Base64 natives functions in Clipper !

Postby Badara Thiam » Sun Sep 13, 2009 3:51 pm

I am happy for you...

Regards.
Badara Thiam
http://www.icim.fr
User avatar
Badara Thiam
 
Posts: 160
Joined: Tue Oct 18, 2005 10:21 am
Location: France

Re: Base64 natives functions in Clipper !

Postby Badara Thiam » Fri Sep 25, 2009 2:50 pm

Hello,
I have upgraded StrToBase64() today. One bug fixed.
No changes in others functions.

Regards.

Code: Select all  Expand view


* 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 == "" )
  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 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. )
 
Badara Thiam
http://www.icim.fr
User avatar
Badara Thiam
 
Posts: 160
Joined: Tue Oct 18, 2005 10:21 am
Location: France

Re: Base64 natives functions in Clipper !

Postby Wiegand » Thu Aug 12, 2010 9:30 pm

Dear Badara Thiam

Thank you for your Contribution. It works well and helped me a lot.

Greatings

Peter Wiegand
Wiegand
 
Posts: 1
Joined: Thu Aug 12, 2010 10:09 am

Re: Base64 natives functions in Clipper !

Postby softruz » Mon Apr 16, 2012 4:55 pm

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)
end if
cTexte:=hex2str(cTexte)

return cTexte
softruz
 
Posts: 485
Joined: Fri Feb 09, 2007 10:34 am


Return to FiveWin for CA-Clipper

Who is online

Users browsing this forum: No registered users and 9 guests