program base64test;

var

EncodeTable: array[0..63] of Char =

'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +

'abcdefghijklmnopqrstuvwxyz' +

'0123456789+/';

DecodeTable: array[#0..#127] of Integer = (

Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,

64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,

64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63,

52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64,

64, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,

15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64,

64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,

41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);

type

PPacket = ^TPacket;

TPacket = packed record

case Integer of

0: (b0, b1, b2, b3: Byte);

1: (i: Integer);

2: (a: array[0..3] of Byte);

3: (c: array[0..3] of Char);

end;

procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);

begin

OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];

OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];

if NumChars < 2 then

OutBuf[2] := '='

else

OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];

if NumChars < 3 then

OutBuf[3] := '='

else

OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];

end;

function Base64Encode(const Input: string): string;

var

I, K, J: Integer;

Packet: TPacket;

begin

Result := '';

I := (Length(Input) div 3) * 4;

if Length(Input) mod 3 > 0 then Inc(I, 4);

SetLength(Result, I);

J := 1;

for I := 1 to Length(Input) div 3 do

begin

Packet.i := 0;

Packet.a[0] := Byte(Input[(I - 1) * 3 + 1]);

Packet.a[1] := Byte(Input[(I - 1) * 3 + 2]);

Packet.a[2] := Byte(Input[(I - 1) * 3 + 3]);

EncodePacket(Packet, 3, PChar(@Result[J]));

Inc(J, 4);

end;

K := 0;

Packet.i := 0;

for I := Length(Input) - (Length(Input) mod 3) + 1 to Length(Input) do

begin

Packet.a[K] := Byte(Input[I]);

Inc(K);

if I = Length(Input) then

EncodePacket(Packet, Length(Input) mod 3, PChar(@Result[J]));

end;

end;

function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket;

begin

Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or

(DecodeTable[InBuf[1]] shr 4);

NChars := 1;

if InBuf[2] <> '=' then

begin

Inc(NChars);

Result.a[1] := (DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2);

end;

if InBuf[3] <> '=' then

begin

Inc(NChars);

Result.a[2] := (DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]];

end;

end;

function Base64Decode(const Input: string): string;

var

I, J, K: Integer;

Packet: TPacket;

begin

Result := '';

for I := 1 to Length(Input) div 4 do

begin

Packet := DecodePacket(PChar(@Input[(I - 1) * 4 + 1]), J);

K := 0;

while J > 0 do

begin

Result := Result + Packet.c[K];

Inc(K);

Dec(J);

end;

end;

end;

var

s: string;

begin

s := 'Test if it works';

WriteLn(s); // original

s := Base64Encode(s);

WriteLn(s); // encoded

s := Base64Decode(s);

WriteLn(s); // decoded

end.