Solved

Base64 Encode/Decode UTF8 Delphi 2010

Posted on 2010-09-03
10
9,517 Views
Last Modified: 2012-05-10
Hello,

I have a Unit where in Delphi 2007 i was able to encode/decode strings being compatible with the PHP version of Base64...

So, a String base64 encoded in PHP, i was able to decode it in my Delphi app..

Now using Delphi 2010, i wanna make it compatible... but i really don't have idea where is the problem... when i try to encode a text, it comes like "Chinese Characters"... i can change all Strings from the Unit to AnsiString but then i don't have a base64 support for Unicode!

Attached is the Unit... somebody know how to make it compatible with Unicode?

I don't have enough knowledge to change things in this unit where will be able to support unicode... in the official website, it's just abandoned and since 2003 there is no updates!
but i know that its possible, since there are a lot of examples over the web but in .NET or javascript, C# not in Delphi :(

To test the unit, is something like

Example, 2 Edits over the form and 1 button

OnButton Click
Edit2.Text := SZFullEncodeBase64(Edit1.Text);

Best Regards,
Carlos SZCodeBaseX.pas
0
Comment
Question by:cebasso
  • 4
  • 4
  • 2
10 Comments
 
LVL 13

Expert Comment

by:aflarin
ID: 33596530
it seems the unit suppose that string is AnsiString, but in D2010 string is WideString.

so, I think you have to change all string types into unit to AnsiString

or maybe there is a compiler directive for that?

0
 
LVL 13

Expert Comment

by:aflarin
ID: 33596580
also you have to change PChar to PAnsiChar

try the attached unit. I've done these changes and checked it on your sample.
{$O+} // Optimization must be ON

{$R-} // Range checking must be OFF



unit SZCodeBaseX;



/////////////////////////////

// Version 1.3.5

////////////////////////////



{



 The contents of this file are subject to the Mozilla Public License

 Version 1.1 (the "License"); you may not use this file except in compliance

 with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/



 Software distributed under the License is distributed on an "AS IS" basis,

 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the

 specific language governing rights and limitations under the License.



 The original code is SZCodeBaseX.pas, released 15. July, 2004.



 The initial developer of the original code is

 Sasa Zeman (public@szutils.net, www.szutils.net)



 Copyright(C) 2004-2007 Sasa Zeman. All Rights Reserved.

}



{--------------------------------------------------------------------



Encode/Decode algorithms for Base16, Base32 and Base64

Reference: RFC 3548



- Universal Encode/Decode algorithms for Base16, Base32 and Base64

- Standard Base16, Base32 and Base64 encoding/decoding functions

- Reference: RFC 3548, full compatibility

- Full MIME suppport

- Supported work with Memory, Stream, String and Files

- Optionally supported work with padding keys (required numbers

  of '=' at the end of the encoded array)

- Very flexible work - you may easily create your own Encode/Decode functions

  based on your own specific codes, from Base2 up to Base128



----------------------------------

Revision History:

----------------------------------



-------------------------

Version 1.3.5, 2007-07-02

-------------------------

  - Bugfix on SZCodeBaseXSetBufferSize;



-------------------------

Version 1.3.4, 2007-03-10

-------------------------

  - Cleaning some useless code

  - Some minor code tweaks

  - Demo update



-------------------------

Version 1.3.3, 2006-12-10

-------------------------

  - Better demo

  - Some minor code reorganization



-------------------------

Version 1.3.2, 2005-07-09

-------------------------

  - Added external functions to calculate Required Output Memory

    Thanks to Grant.



-------------------------

Version 1.3.1, 2005-06-18

-------------------------

  - fixed runtime error in decoding when range checking is ON.

    Thanks to Grant.



-------------------------

Version 1.3.0, 2005-05-03

-------------------------

  - Added MIME support



-------------------------

Version 1.2.1, 2004-11-19

-------------------------

  - Added support for Memory, Stream and Files

  - Added support for Delphi 5 and BCB - pByte issue



-------------------------

Version 1.1.0, 2004-08-21

-------------------------

  - Optimized version, more than 35 times speed acceleration,

    one of the fastest and the simplest universal Base16/32/64 encoder/decoder



-------------------------

Version 1.0.0, 2004-07-15

-------------------------

  - Initial version



----------------------------------



  Author   : Sasa Zeman

  E-mail   : public@szutils.net or sasaz72@mail.ru

  Web site : www.szutils.net

}



interface



uses Windows, SysUtils, Types, Classes;



//////////////////////////////////////////////////////////////////

// Universal Encode/Decode algorithms for Base16, Base32 and Base64

// Actualy, you can create any variation you need, even by your own

// codes from Base2 to Base128

//////////////////////////////////////////////////////////////////



const

  SZCodeBaseXver='1.3.5';



function SZEncodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;

function SZDecodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer): integer;



function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;

function SZDecodeBaseXStream(sIN, sOUT: TStream; const Codes: AnsiString; BITS: integer): integer;



function SZEncodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): AnsiString;

function SZDecodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;



function SZEncodeBaseXFile(const FileName: AnsiString; sOUT: TStream; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;

// Decoding entire file is not supported, as is not logical - file may

// contain any data, or more than one encoded data

// Use the stream realization for precise and logical decoding - even

// for a part of a stream (fully supported)





//////////////////////////////////////////////////////////////////

// Calculates full reqired memory for output

// based on input size, BITS and needs for padding keys

//////////////////////////////////////////////////////////////////



function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;



// Calculates reqired ammount of padding keys based on output size

function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;



//////////////////////////////////////////////////////////////////

// ATTENTION!!!

// Next two functions are for testing purposes only.

// My be deleted in the future.

////////////////////////////////////////////////////////////////////

function SZFullEncodeOnlyBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString;

function SZFullEncodeOnlyBase64_6(const S: AnsiString; MIMELine: integer = 0): AnsiString;



////////////////////////////////////////////////////////////////////

// Base 16

//////////////////////////////////////////////////////////////////



function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZEncodeBase16(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZEncodeBase16(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;

function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;

function SZDecodeBase16(const S: AnsiString): AnsiString; overload;



//////////////////////////////////////////////////////////////////

// Base32, Full encoding mean adding padding keys

//////////////////////////////////////////////////////////////////



function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZFullEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;

function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;

function SZDecodeBase32(const S: AnsiString): AnsiString; overload;



//////////////////////////////////////////////////////////////////

// Base 64, Full encoding mean adding padding keys

//////////////////////////////////////////////////////////////////



function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZFullEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;

function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;

function SZDecodeBase64(const S: AnsiString): AnsiString; overload;



//////////////////////////////////////////////////////////////////

// Base64 URL, Full encoding mean adding padding keys

//////////////////////////////////////////////////////////////////



function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZFullEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZFullEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

function SZEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;



function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;

function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;

function SZDecodeBase64URL(const S: AnsiString): AnsiString; overload;





//////////////////////////////////////////////////////////////////

// Calculating Required Output Memory

//////////////////////////////////////////////////////////////////



function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;

function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;



function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;

function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;



function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;



//////////////////////////////////////////////////////////////////

// Setting Buffer Size procedure

//////////////////////////////////////////////////////////////////



procedure SZCodeBaseXSetBufferSize(Size:integer);

procedure SZCodeBaseXSetOrigBufferSize;



//////////////////////////////////////////////////////////////////



implementation



const



  // Basic size for buffer is 64KB

  SZORIGBUFFSIZE = 64*1024;



///////////////////////////////////////////

/// Base 64 definitions

///////////////////////////////////////////



  SZCodes64    = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

  SZCodes64URL = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';

  SZBITS64 = 6;



  // Resulted number of chars must be integral multiple of

  // 24 input bits div 6 output group bits

  SZFullQuantum64 = 24 div 6;



///////////////////////////////////////////



///////////////////////////////////////////

/// Base 32 definitions

///////////////////////////////////////////



  SZCodes32 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';

  SZBITS32 = 5;



  // Resulted number of chars must be integral multiple of

  // 40 input bits div 5 output group bits

  SZFullQuantum32 = 40 div 5;



  // If there is no need for padding keys

  SZFullQuantum0 = 0;



///////////////////////////////////////////

/// Base 16 definitions

///////////////////////////////////////////



  SZCodes16 = '0123456789ABCDEF';

  SZBITS16 = 4;



///////////////////////////////////////////



type

  TFastDecodeTable=array[0..255] of byte;



var

  // Optimized buffer length for encoding files up to 64KB

  // Important for speed-up works with large streams



  SZBUFFSIZE: integer;



  SZFastDecodeTable: TFastDecodeTable;



////////////////////////////

// Basic Functions

////////////////////////////



procedure SZUpdateFastDecodeTable(const Codes: AnsiString);

var

  i: integer;

begin

  FillChar(SZFastDecodeTable,256,#0);



  for i := 1 to length(Codes) do

    SZFastDecodeTable[ byte( Codes[i] ) ] := i;

end;



function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;

{

  Adding necessary padding keys to create a full

  RFC 3548 compatibility string

}

var

  IM: integer;

begin



  if FullQuantum>0 then

    IM:=Size mod FullQuantum

  else

    IM:=0;



  if IM>0 then

    Result:=FullQuantum-IM

  else

    Result:=0

end;



function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;

var

  TotalOut, IM, MIMEOut: integer;

begin



  TotalOut := TotalIn shl 3; // * 8



  if TotalOut mod BITS > 0 then

    TotalOut:= TotalOut div BITS +1

  else

    TotalOut:= TotalOut div BITS;



  if MIMELine>0 then

    MIMEOut:= ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2

  else

    MIMEOut:= 0;



  if FullQuantum>0 then

  begin

    IM:=TotalOut mod FullQuantum;



    if IM>0 then

      TotalOut:= TotalOut + FullQuantum-IM;

  end;



  // Additional space for CRLF (2 bytes) if MIME encoding is required

  if MIMELine>0 then

    TotalOut:= TotalOut + MIMEOut;



  result:=TotalOut;

end;





procedure GetRelevantData(TotalIn: integer; var TotalOut: integer;

        BITS, FullQuantum: integer; var IM: integer; MIMELine: integer);

var

  MIMEOut: integer;

begin



  TotalOut:=TotalIn shl 3; // * 8



  if TotalOut mod BITS > 0 then

    TotalOut:= TotalOut div BITS +1

  else

    TotalOut:= TotalOut div BITS;



  if MIMELine>0 then

    MIMEOut:= ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2

  else

    MIMEOut:=0;



  if FullQuantum>0 then

  begin

    IM:=TotalOut mod FullQuantum;



    if IM>0 then

      TotalOut:= TotalOut + FullQuantum-IM;

  end

  else

    IM:=0;



  // Additional space for CRLF (2 bytes) if MIME encoding is required

  if MIMELine>0 then

    TotalOut:= TotalOut + MIMEOut

end;





////////////////////////////

// Memory

////////////////////////////



function SZEncodeBaseXMemoryUpdate(pIN: PByte; var pOUT: PByte; Size: integer; const Codes: AnsiString; BITS: integer; var vB8, VI8: integer; MIMELine: integer; Var MIMECountdown, MIMEBytesCount: integer): integer;

{

  Universal Encode algorithm for Base16, Base32 and Base64

  Reference: RFC 3548

  RFC incompatibility: No padding keys

}



const Mask: array [0..16] of Word=

(  0, 1, 3, 7, 15, 31, 63,

   127,   255,  511,  1023,   2047,

  4095,  8191, 16383, 32767, 65535

);



var

  i,B8, I8, Count: integer;

  MIME: Boolean;

begin



  MIME:=MIMELine > 0;



  Count:=0;



  B8 := vB8;

  I8 := vI8;



  for i := 1 to Size do

  begin

    B8 := B8 shl 8;

    B8 := B8 or pIN^;

    I8 := I8 + 8;



    while I8 >= BITS do

    begin



      I8 := (I8 - BITS);



      // Get first BITS of bits

      PAnsiChar(pOUT)^ := Codes[(B8 shr I8)+1];

      inc(pOUT);



      inc(Count);



      if MIME then

      begin



        MIMECountdown := MIMECountdown - 1;



        if MIMECountdown <= 0 then

        begin

           MIMECountdown := MIMELine;

           MIMEBytesCount := MIMEBytesCount + 2;



           // Put CRLF

           pOUT^ := 13; inc(pOUT);

           pOUT^ := 10; inc(pOUT);



           inc(Count,2);



        end;



      end;



      //Return position back for BITS bits

      //B8 := B8 - ((B8 shr I8) shl I8);



      // The same result as upper code, a bit faster

      B8 := B8 and MASK[I8];



    end;



    inc(pIN);



  end;



  vB8 := B8;

  vI8 := I8;



  result:=Count;

end;

                 

function SZEncodeBaseXMemoryFinalyze(var pOUT: PByte; const Codes: AnsiString; BITS: integer; B8, I8: integer): integer;

// Finalyzing encoding with last left bites (if any)

begin

  // If something left

  if I8 > 0 then

  begin

    PAnsiChar(pOUT)^ := Codes[ (B8 shl (BITS-I8)) + 1];

    inc(pOUT);

    result:=1;

  end else

    result:=0;

end;



function SZEncodeBaseXMemory(pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;

var

  B8,I8: integer;



  TotalOut : integer;

  IM       : integer;



  MIMECountdown  : integer;

  MIMEBytesCount : integer;



  ppIN, ppOUT: pByte;

begin

  B8:=0;

  I8:=0;



  ppIN  := pIN;

  ppOUT := pOut;



  MIMECountdown  := MIMELine;

  MIMEBytesCount := 0;



  TotalOut:=SZEncodeBaseXMemoryUpdate(ppIN, ppOUT, Size, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);



  // If something left

  if I8>0 then

    TotalOut:=TotalOut+

      SZEncodeBaseXMemoryFinalyze(ppOut, Codes, BITS, B8, I8);



  if FullQuantum>0 then

  begin



    // Calculate relevant data

    //GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);



    // Get required padding keys

    IM:=SZCalcRequiredPaddingKeys(TotalOut - MIMEBytesCount, FullQuantum);



    if IM>0 then

    begin

      FillChar( ppOUT^, IM,'=');

      PAnsiChar(ppOut):=PAnsiChar(ppOut)+IM;



      TotalOut:=TotalOut + IM

    end

  end;



  result:=TotalOut;

end;





function SZDecodeBaseXMemoryUpdate(pIN,pOUT: pByte; Size: integer; const FastDecodeTable: TFastDecodeTable; BITS: integer; var B8, I8 : integer): integer;

{

  Universal Decode algorithm for Base16, Base32 and Base64

  Reference: RFC 3548 - full compatibility

}



var

  i: Integer;

  TotalIN, Count: integer;



begin



  TotalIN  := Size;



  // Start decoding

  count := 0;

  for i := 1 to TotalIN do

  begin



    if SZFastDecodeTable[pIN^] > 0 then

    begin



      B8 := B8 shl BITS;

      B8 := B8 or (SZFastDecodeTable[pIN^]-1);



      I8 := I8 + BITS;



      while I8 >= 8 do

      begin

        I8 := I8 - 8;



        pOUT^ := Byte(B8 shr I8);

        inc( pOUT );



        inc(count)

      end;



      inc(pIN);

    end

    else if pIN^=13 then inc(pIN)

    else if pIN^=10 then inc(pIN)

    else

      break

  end;



  result:=Count;

end;



function SZDecodeBaseXMemory(pIN,pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer): integer;

{

  Universal Decode algorithm for Base16, Base32 and Base64

  Reference: RFC 3548 - full compatibility

}



var

  B8, I8 : integer;

begin

  B8:=0;

  I8:=0;



  SZUpdateFastDecodeTable(Codes);



  result:=SZDecodeBaseXMemoryUpdate( pIN, pOUT, Size, SZFastDecodeTable, BITS, B8, I8);

end;



function SZDecodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;

var

  TotalIn  : integer;

  TotalOut : integer;



  pIN,pOUT: pByte;



begin



  TotalIn  := length(S);

  TotalOut := (TotalIn * BITS) shr 3; // div 8;



  Setlength(Result,TotalOut);



  pIN  := @S[1];

  pOUT := @Result[1];



  TotalOut:=SZDecodeBaseXMemory( pIN, pOUT, TotalIn, Codes, BITS);



  if length(Result)<> TotalOut then

    Setlength(Result,TotalOut);

end;



function SZEncodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer ; MIMELine : integer): AnsiString;

// Universal Encode algorithm for Base16, Base32 and Base64

var

  pIN, pOUT: pByte;



  TotalIn, TotalOut: integer;

  IM: integer;

  LOut: integer;

begin

  TotalIn  := length(S);



  // Calculate relevant data

  GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);



  SetLength(Result,TotalOut);



  pIN :=@S[1];

  pOUT:=@Result[1];



  LOut:=SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);



  if Lout<>TotalOut then

    SetLength(Result,LOut);

end;



//////////////////////////

// Stream

//////////////////////////



function SZEncodeBaseXStreamUpdate(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; var vB8, vI8: integer; MIMELine: integer; Var MIMECountdown, MIMEByteCount: integer): integer;

var

  pBuffIn, pBuffOut: pByte;

  Res,BUFF : Integer;

  pIn,pOut: pByte;

  LOut,Count,TotalIn, TotalOut, MIMEOut: integer;

begin



  BUFF := SZBUFFSIZE;



  TotalIn:=Size;



  if BUFF > TotalIn  then

    BUFF := TotalIn + 1;



  TotalOut := BUFF shl 3; // * 8



  if TotalOut mod BITS > 0 then

    TotalOut := TotalOut div BITS +1

  else

    TotalOut := TotalOut div BITS;



  if MIMELine>0 then

    MIMEOut := ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2

  else

    MIMEOut := 0;



  TotalOut := TotalOut + MIMEOut;



  // Get memory for it

  GetMem(pBuffIn,BUFF);

  GetMem(pBuffOut,TotalOut);



  Count := 0;



  repeat

    Res := sIn.Read(pBuffIn^, BUFF);



    pIn  := pBuffIn;

    pOut := pBuffOut;



    LOut:=SZEncodeBaseXMemoryUpdate(pIn,pOut, Res, Codes, BITS, vB8, vI8, MIMELine, MIMECountdown, MIMEByteCount);

    sOut.Write(pBuffOut^,LOut);



    Count := Count + LOut;



  until (Res <> LongInt(BUFF));



  FreeMem(pBuffIn);

  FreeMem(pBuffOut);



  result:=Count;

end;



function SZEncodeBaseXStreamFinalyze(sOUT: TStream; const Codes: AnsiString; BITS: integer; var B8, I8: integer): integer;

var

  pOut: pByte;

  b: byte;

begin

  pOut:=@b;



  Result:=SZEncodeBaseXMemoryFinalyze(pOUT, Codes, BITS, B8, I8);



  if Result>0 then

    sOut.Write(b,Result);

end;



function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;

var

  B8, I8: integer;



  TotalIn  : integer;

  TotalOut : integer;

  IM       : integer;



  MIMECountdown : integer;

  MIMEBytesCount: integer;

begin



  if size=0 then

  begin

    result:=0;

    exit

  end;



  // This is important code if you encode just part of a stream

  if size<0 then

    TotalIn:= sIn.Size-sIn.Position

  else

    TotalIn:= Size;



  B8:=0;

  I8:=0;



  MIMECountdown  := MIMELine;

  MIMEBytesCount := 0;



  TotalOut:=SZEncodeBaseXStreamUpdate(sIN, sOUT, TotalIn, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);



  // If something left

  if I8>0 then

    TotalOut:=TotalOut + SZEncodeBaseXStreamFinalyze(sOUT, Codes, BITS, B8, I8);



  if FullQuantum>0 then

  begin



    // Calculate relevant data

    // GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);



    // Get required padding keys

    IM:=SZCalcRequiredPaddingKeys(TotalOut-MIMEBytesCount, FullQuantum);



    if IM > 0 then

    begin

      sOut.Write(PAnsiChar(StringOfChar('=',IM))^,IM);

      TotalOut:=TotalOut+IM

    end



  end;



  result:=TotalOut;

end;



function SZDecodeBaseXStream(sIN, sOUT: TStream;  const Codes: AnsiString; BITS: integer): integer;

var

  TotalIn  : integer;

  TotalOut : integer;



  pIn,pOut: pByte;



  pBuffIn, pBuffOut: pByte;

  Res,BUFF : Integer;

  LOut,Count: integer;



  B8, I8: integer;

begin



  BUFF := SZBUFFSIZE;



  // This is important code if you encode just a part of a stream

  TotalIn := sIn.Size - SIn.Position;



  if BUFF > TotalIn  then

    BUFF := TotalIn + 1;



  TotalOut := BUFF;



  // Get memory for it

  GetMem(pBuffIn,BUFF);

  GetMem(pBuffOut,TotalOut);



  Count := 0;



  B8 := 0;

  I8 := 0;



  SZUpdateFastDecodeTable(Codes);



  repeat

    Res := sIn.Read(pBuffIn^, BUFF);



    pIn  := pBuffIn;

    pOut := pBuffOut;



    Lout := SZDecodeBaseXMemoryUpdate(pIN, pOUT, Res, SZFastDecodeTable, BITS, B8, I8);



    sOut.Write(pBuffOut^,LOut);



    Count := Count + LOut;



  until (Res <> LongInt(BUFF));



  FreeMem(pBuffOut);

  FreeMem(pBuffIn);



  result := Count;

end;



function SZEncodeBaseXFile(const FileName: AnsiString; sOUT: TStream; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;

var

  sIn: TFileStream;

  Size: integer;

begin

  sIn := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);



  Size:= sIn.Size;



  try

    result:= SZEncodeBaseXStream(sIN, sOUT, Size, Codes, BITS, FullQuantum, MIMELine);

  finally

    sIn.Free;

  end;

end;



///////////////////////////////////////////////////

// File to stream

///////////////////////////////////////////////////



function SZFullEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZFullEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZFullEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);

end;



function SZEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase16(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);

end;



////////////////////////////////////////////////////////////

///    Base16

////////////////////////////////////////////////////////////



function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

begin

  result:= SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN, sOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase16(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine)

end;



function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;

begin

  result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16);

end;



function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;

begin

  result:= SZDecodeBaseXStream(sIN,sOUT, SZCodes16, SZBITS16);

end;



function SZDecodeBase16(const S: AnsiString): AnsiString; overload;

begin

  Result:=SZDecodeBaseXString(S, SZCodes16, SZBITS16)

end;



////////////////////////////////////////////////////////////

/// Base32

////////////////////////////////////////////////////////////



function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer;  overload;

begin

  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);

end;



function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);

end;



function SZFullEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);

end;



function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine)

end;



function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;

begin

  result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32);

end;



function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;

begin

  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes32, SZBITS32);

end;



function SZDecodeBase32(const S: AnsiString): AnsiString; overload;

begin

  Result:=SZDecodeBaseXString(S, SZCodes32, SZBITS32)

end;



////////////////////////////////////////////////////////////

/// Base64

////////////////////////////////////////////////////////////



function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer;  overload;

begin

  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZFullEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString;  overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine)

end;



function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine)

end;



function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;

begin

  result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64);

end;



function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;

begin

  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64, SZBITS64);

end;



function SZDecodeBase64(const S: AnsiString): AnsiString; overload;

begin

  Result:=SZDecodeBaseXString(S, SZCodes64, SZBITS64)

end;



////////////////////////////////////////////////////////////

///  Base64 URL table

////////////////////////////////////////////////////////////



function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZFullEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine)

end;



function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine)

end;



function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;

begin

  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;

begin

  result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64URL, SZBITS64);

end;



function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;

begin

  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64URL, SZBITS64);

end;



function SZDecodeBase64URL(const S: AnsiString): AnsiString; overload;

begin

  Result:=SZDecodeBaseXString(S, SZCodes64URL, SZBITS64)

end;



//////////////////////////////////////////////////////////////



procedure SZCodeBaseXSetBufferSize(Size:integer);

begin

  // Do not allow Buffers size less than original

  // to avoid drastic performace decresing with streams



  if size < SZORIGBUFFSIZE then

    SZBUFFSIZE := Size

  else

    SZBUFFSIZE := SZORIGBUFFSIZE;

end;



procedure SZCodeBaseXSetOrigBufferSize;

begin

  SZCodeBaseXSetBufferSize(SZORIGBUFFSIZE);

end;



//////////////////////////////////////////////////////////////////

// Calculating Required Output Memory

//////////////////////////////////////////////////////////////////



function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum64, MIMELine);

end;



function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum32, MIMELine);

end;



function SZCalcRequiredOutputMemoryForFullEncodeBase16(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);

end;



function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum0, MIMELine);

end;



function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum0, MIMELine);

end;



function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;

begin

  Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);

end;



//////////////////////////////////////////////////////////////

///      END OF ACTUAL CODE

//////////////////////////////////////////////////////////////



//////////////////////////////////////////////////////////////

//Additional code may be deleted in the future

//////////////////////////////////////////////////////////////



const

  codes64: array[0..63] of byte = (

    065, 066, 067, 068, 069, 070, 071, 072,

    073, 074, 075, 076, 077, 078, 079, 080,

    081, 082, 083, 084, 085, 086, 087, 088,

    089, 090, 097, 098, 099, 100, 101, 102,

    103, 104, 105, 106, 107, 108, 109, 110,

    111, 112, 113, 114, 115, 116, 117, 118,

    119, 120, 121, 122, 048, 049, 050, 051,

    052, 053, 054, 055, 056, 057, 043, 047);



function SZFullEncodeOnlyBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString;

{

 Encode algorithm for Base64

 Reference: RFC 3548 - full compatibility



 ATTENTION! MIMELine here in not in use!

}



type

  TBI3= packed array [0..2] of byte;

  pBI3= ^TBI3;



  TBO4= packed array [0..3] of byte;

  pBO4= ^TBO4;

var

  i: integer;



  pIN: pBI3;

  pOUT: pBO4;



  TotalIn, TotalOut, TotalInRest: integer;

  B32: longword;



begin



  TotalIn  := length(s);

  TotalOut := (TotalIn + 2) div 3 * 4 ;

  TotalINRest:= TotalIn - TotalIN div 3 * 3;



  SetLength(Result, TotalOut);



  pIN  := @S[1];

  pOUT := @Result[1];



  // Start coding

  for i := 1 to TotalIn Div 3 do

  begin



    // Set new DWORD value in format

    // 00000000 11111111 22222222 33333333



    B32 := (pIN[0] shl 16) or (pIN[1] shl 8) or (pIn[2]);

    inc(pIN);



    pOUT[3] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;

    pOUT[2] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;

    pOUT[1] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;

    pOUT[0] := Codes64[ B32          ];



    inc(pOUT);



  end;



  if TotalINRest = 1 then

  begin

    B32:= (pIn[0] shl 4) ;



    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[0] := Codes64[ B32         ];



    pOUT[3] := byte('=');

    pOUT[2] := byte('=');

  end

  else

  if TotalINRest = 2

  then

  begin

    B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;



    pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[0] := Codes64[ B32         ];



    pOUT[3] := byte('=');



  end



end;





function SZFullEncodeOnlyBase64_6(const S: AnsiString; MIMELine: integer = 0): AnsiString;

{

 Encode algorithm for Base64

 Reference: RFC 3548 - full compatibility



 ATTENTION! MIMELine here in not in use!

}



type



  TBI3= packed array [0..2] of byte;

  pBI3= ^TBI3;



  TBO4= packed array [0..3] of byte;

  pBO4= ^TBO4;



var

  i: integer;



  pIN: pBI3;

  pOUT: pBO4;



  TotalIn, TotalOut, TotalINRest: integer;

  B32: longword;



begin



  TotalIn  := length(s);

  TotalOut := (TotalIn + 2) div 3 * 4 ;

  TotalINRest:= TotalIn - TotalIN div 3 * 3;



  SetLength(Result, TotalOut);



  pIN  := @S[1];

  pOUT := @Result[1];



  // This variation encode directly form input DWORD



  // Start coding

  for i := 1 to TotalIn Div 3 do

  begin



    B32:=pLongWord(pIN)^;

    inc(pIN);



    pOUT[0] := Codes64[((B32 shr  2) and $3F)];

    pOUT[1] := Codes64[((B32 shl  4) and $3F) or ((B32 shr 12) and $0F)];

    pOUT[2] := Codes64[((B32 shr  6) and $3C) or ((B32 shr 22) and $03)];

    pOUT[3] := Codes64[((B32 shr 16) and $3F)];



    inc(pOUT);



  end;



  if TotalINRest = 1 then

  begin

    B32:= (pIn[0] shl 4) ;



    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[0] := Codes64[ B32         ];



    pOUT[3] := byte('=');

    pOUT[2] := byte('=');

  end

  else

  if TotalINRest = 2

  then

  begin

    B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;



    pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;

    pOUT[0] := Codes64[ B32         ];



    pOUT[3] := byte('=');

  end



end;





Initialization

  SZCodeBaseXSetOrigBufferSize;



end.

Open in new window

0
 
LVL 13

Expert Comment

by:aflarin
ID: 33596737
>> or maybe there is a compiler directive for that?

I know D2009 has not it, but maybe it appears in D2010/Delphi XE?
0
 
LVL 25

Expert Comment

by:epasquier
ID: 33596761
when encoding WideString -> Base64 String, that Base64 string is ANSIString.
And when decoding, you have to consider the same : source Base64 is ANSIString, and result is widestring.

So it is not just so simple as to change String into AnsiString. You have to choose which need to be changed.

I have a smaller unit for base64, I've upgraded it for Unicode so that you can either use it or see how to change your own unit. Beware, I haven't tested it (don't have Delphi >2009...)
unit Code64;



interface



function Encode64(S: string): string;

function Decode64(S: string): string;

function Encode64Unicode(S: string): string;

function Decode64Unicode(S: string): string;



implementation



const

  Codes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';



function Encode64(S: string): string;

var

  i: Integer;

  a: Integer;

  x: Integer;

  b: Integer;

begin

  Result := '';

  a := 0;

  b := 0;

  for i := 1 to Length(s) do

  begin

    x := Ord(s[i]);

    b := b * 256 + x;

    a := a + 8;

    while a >= 6 do

    begin

      a := a - 6;

      x := b SHR a;//div (1 shl a);

      b := b AND ((1 SHL a)-1); //mod (1 shl a);

      Result := Result + Codes64[x + 1];

    end;

  end;

  if a > 0 then

  begin

    x := b shl (6 - a);

    Result := Result + Codes64[x + 1];

  end;

end;



function Decode64(S: string): string;

var

  i: Integer;

  a: Integer;

  x: Integer;

  b: Integer;

begin

  Result := '';

  a := 0;

  b := 0;

  for i := 1 to Length(s) do

  begin

    x := Pos(s[i], codes64) - 1;

    if x >= 0 then

    begin

      b := b * 64 + x;

      a := a + 6;

      if a >= 8 then

      begin

        a := a - 8;

        x := b shr a;

        b := b AND ((1 SHL a)-1);

        Result := Result + chr(x);

      end;

    end

    else

      Exit;

  end;

end;



function Encode64Unicode(S: WideString): ANSIString;

var

  i: Integer;

  a: Integer;

  x: Integer;

  b: Integer;

  p : pByte;

  l :Integer;

begin

  Result := '';

  a := 0;

  b := 0;

  l:=Length(s)*SizeOf(WideChar);

  p:=pByte(@s[1]);

  for i := 0 to L-1 do

  begin    

    x := p^;

    Inc(p);

    b := b * 256 + x;

    a := a + 8;

    while a >= 6 do

    begin

      a := a - 6;

      x := b SHR a;//div (1 shl a);

      b := b AND ((1 SHL a)-1); //mod (1 shl a);

      Result := Result + Codes64[x + 1];

    end;

  end;

  if a > 0 then

  begin

    x := b shl (6 - a);

    Result := Result + Codes64[x + 1];

  end;

end;



function Decode64Unicode(S: ANSIString): WideString;

var

  i: Integer;

  a: Integer;

  x: Integer;

  b: Integer;

  p : pByte;

begin

  Result := '';

  a := 0;

  b := 0;

  SetLength(Result, (length(s)+ 2) div 3 * 4);

  p:=pByte(@Result[1]);

  for i := 1 to Length(s) do

  begin

    x := Pos(s[i], codes64) - 1;

    if x >= 0 then

    begin

      b := b * 64 + x;

      a := a + 6;

      if a >= 8 then

      begin

        a := a - 8;

        x := b shr a;

        b := b AND ((1 SHL a)-1);

        p^:= x;

        Inc(p);

        //Result := Result + chr(x);

      end;

    end

    else

      Exit;

  end;

end;



end.

Open in new window

0
 
LVL 25

Accepted Solution

by:
epasquier earned 250 total points
ID: 33596883
In your unit, you can note that all overloaded functions that works on memory pointers or stream will work as well as they should. Only the string versions need to be changed.

As such, especially
SZDecodeBaseXString
and
SZEncodeBaseXString

need some fixing, and others that call them to specialize (base 16,32,64)
function SZDecodeBaseXString(const S: ANSIString; const Codes: String; BITS: integer): WideString;

var

  TotalIn  : integer;

  TotalOut : integer;



  pIN,pOUT: pByte;



begin



  TotalIn  := length(S);

  TotalOut := (TotalIn * BITS) shr 3; // div 8;



  Setlength(Result,(TotalOut+1) Div 2);



  pIN  := @S[1];

  pOUT := @Result[1];



  TotalOut:=SZDecodeBaseXMemory( pIN, pOUT, TotalIn, Codes, BITS);



  if length(Result)<> TotalOut then

    Setlength(Result,TotalOut);

end;



function SZEncodeBaseXString(const S: WideString; const Codes: string; BITS: integer; FullQuantum : integer ; MIMELine : integer): ANSIString;

// Universal Encode algorithm for Base16, Base32 and Base64

var

  pIN, pOUT: pByte;



  TotalIn, TotalOut: integer;

  IM: integer;

  LOut: integer;

begin

  TotalIn  := length(S)*SizeOf(WideChar);



  // Calculate relevant data

  GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);



  SetLength(Result,TotalOut);



  pIN :=@S[1];

  pOUT:=@Result[1];



  LOut:=SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);



  if Lout<>TotalOut then

    SetLength(Result,LOut);

end;





function SZDecodeBase64(const S: ANSIString): WideString; overload;

begin

  Result:=SZDecodeBaseXString(S, SZCodes64, SZBITS64)

end;



function SZEncodeBase64(const S: WideString; MIMELine: integer = 0): ANSIString; overload;

begin

  Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine)

end;

Open in new window

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 4

Author Comment

by:cebasso
ID: 33598348
Hey, thanks both for reply!
But then, the final conclusion is that for "Arabic, Chineses characters" there is not support?
Example, i can convert to base64 only ANSI characters and not UTF-8(Unicode) characters?
Both examples works perfectly, but i tried to encode and decode arabic chars and of course, returning AnsiString will lost data (wide chars) hehe
0
 
LVL 25

Expert Comment

by:epasquier
ID: 33598563
no, my functions should be able to encode unicode to b64(ansi) and back to unicode. i am gone now and cannot check. aflarin code do have the restriction you are talking about because he did not mix ansi & wide strings (he used ansi everywhere)
0
 
LVL 13

Assisted Solution

by:aflarin
aflarin earned 250 total points
ID: 33599345
>> Only the string versions need to be changed.

I don't think so. If you changed those - What will you do if the encoded text was ANSI? You decoded unicode string will contain rubbish.

So, if you would like to modify the original code, you can ADD new epasquier's functions. Then you will have two ones:

// original
// if your encoded string is ANSI
function SZDecodeBaseXString(const S: ANSIString; const Codes: AnsiString; BITS: integer): AnsiString;
// epasquier's function
// if your encoded string is UNICODE
function SZDecodeBaseXStringW(const S: AnsiString; const Codes: AnsiString; BITS: integer): WideString;
// amd the same for Base64, Base32, Base16

But then it would be worse if they duplicate code. It would be better if the Unicode function will call Ansi function. In addition it will be shorter:

function SZDecodeBaseXStringW(const S: AnsiString; const Codes: AnsiString; BITS: integer): WideString;
begin
  Result:= RawByteString( SZDecodeBaseXStringW(S, Codes, BITS) );
end;


But you can manage your encoded unicode string ("Arabic, Chineses characters") without adding Unicode functions, like this:

procedure TForm1.Button2Click(Sender: TObject);
var
  original: WideString;
  encoded: AnsiString;
  decoded: WideString;
begin
  // Test unicode string
  original:= 'You can write here your Arabic, Chineses characters';

  { encoding }
  // Result is AnsiString
  encoded:= SzFullEncodeBase64( RawByteString(original) );

  { decoding }
  // SzDecodeBase64 returns AnsiString, but it really contains Unicode, so we save it to Unicode variable
  decoded:= RawByteString( SzDecodeBase64( encoded ) );

  { testing }
  ShowMessage( decoded );
end;

0
 
LVL 25

Expert Comment

by:epasquier
ID: 33607650
> I don't think so. If you changed those - What will you do if the encoded text was ANSI?
> You decoded unicode string will contain rubbish.
No, if you call a function needing unicode parameter with an ANSI string, Delphi will first convert the ANSI string with its Unicode equivalent. Then the encoding would work and produce an ANSI string (twice the size of the one that an encoding function working with ANSI param would) and then the decode would produce again the same Unicode string that Delphi converted. And if you copy that to an ANSIString variable, you will get the original ANSI string, without problems. But yes, it is better to have 2 set of functions to avoid unnecessary conversions
0
 
LVL 4

Author Closing Comment

by:cebasso
ID: 33639331
Thanks both!
I'll split the points since every comment gave me ideas and helped me!

Best Regards,
Carlos
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now