unit base64;

interface

uses SysUtils, Classes;

// Convierte datos binarios a texto (base64)
function BinToStr(Data: PByteArray; Len: Integer): AnsiString;
// Convierte texto a datos binarios
function StrToBin(Str: AnsiString; var Len: Integer): PByteArray;
// Convierte texto a datos binarios, y los guarda en un stream
procedure StrToStream(Str: String; Stream: TStream);

implementation

var
  Table: array[0..255] of AnsiChar;
  invTable: array[#0..#255] of Byte;

// Rellenamos la tablas auxiliares
procedure InitTables;
var
  i: Integer;
  c: AnsiChar;
begin
  FillChar(Table,Sizeof(Table),#0);
  FillChar(invTable,Sizeof(Table),#$FF);
  i:= 0;
  for c:= 'A' to 'Z' do
  begin
    Table[i]:= c;
    invTable[c]:= i;
    inc(i);
  end;
  for c:= 'a' to 'z' do
  begin
    Table[i]:= c;
    invTable[c]:= i;
    inc(i);
  end;
  for c:= '0' to '9' do
  begin
    Table[i]:= c;
    invTable[c]:= i;
    inc(i);
  end;
  Table[62]:= '+';
  Table[63]:= '/';
  invTable['+']:= 62;
  invTable['/']:= 63;
end;

function BinToStr(Data: PByteArray; Len: Integer): AnsiString;
begin
  Result:= EmptyStr;
  while Len > 2 do
  begin
    Result:= Result + Table[Data[0] shr 2];
    Result:= Result + Table[((Data[0] and $03) shl 4) + (Data[1] shr 4)];
    Result:= Result + Table[((Data[1] and $0F) shl 2) + (Data[2] shr 6)];
    Result:= Result + Table[Data[2] and $3F];
    inc(PByte(Data),3);
    dec(Len,3);
  end;
  case Len of
    2: begin
         Result:= Result + Table[Data[0] shr 2];
         Result:= Result + Table[((Data[0] and $03) shl 4) + (Data[1] shr 4)];
         Result:= Result + Table[((Data[1] and $0F) shl 2)];
         Result:= Result + '=';
       end;
    1: begin
         Result:= Result + Table[Data[0] shr 2];
         Result:= Result + Table[((Data[0] and $03) shl 4)];
         Result:= Result + '==';
       end;
  end;
end;

// Limpia una cadena elimnando los caracteres que sobran
function Clean(Str: PAnsiChar): Integer;
var
  P: PAnsiChar;
begin
  Result:= 0;
  P:= Str;
  while Boolean(Str^) do
  begin
    if invTable[Str^] <> $FF then
    begin
      P^:= Str^;
      inc(P);
      inc(Result);
    end;
    inc(Str);
  end;
end;

function StrToBin(Str: AnsiString; var Len: Integer): PByteArray;
var
  i: Integer;
begin
  Result:= nil;
  // Limpiamos todo
  SetLength(Str,Clean(PAnsiChar(Str)));
  // Reservamos memoria para el resultado
  Len:= (Length(Str) div 4) * 3;
  case Length(Str) mod 4 of
    0: ;
    3: inc(Len,2);
    2: inc(Len);
    else Exit;
  end;
  GetMem(Result, Len);
  for i:= 0 to (Len div 3) - 1 do
  begin
    Result[3*i]:=      (invTable[Str[(4*i)+1]] shl 2)
      + (invTable[Str[(4*i)+2]] shr 4);
    Result[(3*i)+1]:= ((invTable[Str[(4*i)+2]] and $0F) shl 4)
      + (invTable[Str[(4*i)+3]] shr 2);
    Result[(3*i)+2]:= ((invTable[Str[(4*i)+3]] and $03) shl 6)
      + invTable[Str[(4*i)+4]];
  end;
  i:= (Len div 3);
  case Length(Str) mod 4 of
    3: begin
         Result[3*i]:=      (invTable[Str[(4*i)+1]] shl 2)
           + (invTable[Str[(4*i)+2]] shr 4);
         Result[(3*i)+1]:= ((invTable[Str[(4*i)+2]] and $0F) shl 4)
           + (invTable[Str[(4*i)+3]] shr 2);
       end;
    2: begin
         Result[3*i]:=      (invTable[Str[(4*i)+1]] shl 2)
           + (invTable[Str[(4*i)+2]] shr 4);
       end;
  end;
end;

procedure StrToStream(Str: String; Stream: TStream);
var
  Len: Integer;
  Buffer: PByteArray;
begin
  Buffer:= StrToBin(Str,Len);
  if Buffer <> nil then
  try
    Stream.WriteBuffer(Buffer^,Len);
  finally
    // No hay que olvidar liberar la memoria reservada por StrToBin
    FreeMem(Buffer);
  end;
end;

initialization
  InitTables;
end.

{unit base64;

interface

uses Windows, SysUtils, Classes;

function BinToStr(Binary: PByte; Len: Cardinal): String;
procedure StrToStream(Str: String; Stream: TStream);

implementation

const
  CRYPT_STRING_BASE64 = 1;

function CryptBinaryToString(pbBinary: PByte; cbBinary: DWORD; dwFlags: DWORD;
  pszString: PChar; var pcchString: DWORD): BOOL; stdcall;
  external 'Crypt32.dll' name 'CryptBinaryToStringA';

function CryptStringToBinary(pszString: PChar; cchString: DWORD; dwFlags: DWORD;
  pbBinary: PByte; var pcbBinary: DWORD; pdwSkip: PDWORD;
  pdwFlags: PDWORD): BOOL; stdcall;
  external 'Crypt32.dll' name 'CryptStringToBinaryA';

function BinToStr(Binary: PByte; Len: Cardinal): String;
var
  Count: DWORD;
begin
  Count:= 0;
  if CryptBinaryToString(Binary,Len,CRYPT_STRING_BASE64,nil,Count) then
  begin
    SetLength(Result,Count);
    if not CryptBinaryToString(Binary,Len,CRYPT_STRING_BASE64,PChar(Result),
      Count) then
      Result:= EmptyStr;
  end;
end;

procedure StrToStream(Str: String; Stream: TStream);
var
  Buffer: PByte;
  Count: DWORD;
begin
  Count:= 0;
  if CryptStringToBinary(PChar(Str),Length(Str),CRYPT_STRING_BASE64,nil,Count,
    nil,nil) then
  begin
    GetMem(Buffer,Count);
    try
      if CryptStringToBinary(PChar(Str),Length(Str),CRYPT_STRING_BASE64,Buffer,
        Count,nil,nil) then
        Stream.WriteBuffer(Buffer^,Count);
    finally
      FreeMem(Buffer);
    end;
  end;
end;

end.        }
