unit EncodeforUnit;

{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}

interface

uses Classes, Sysutils, Types;

function EncodeFileForUnit(FileName: string): string;
procedure DecodeFileFromUnit(Inp: string; Strm: TMemoryStream);
function DecodeBase64(const Value: AnsiString): AnsiString;
function EncodeBase64(const Value: AnsiString): AnsiString;

function WrapForUnit(inp: string): string;

implementation


//from Synapse synacode
const
  TableBase64 =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

  ReTablebase64 =
    #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$3E + #$40
    + #$40 + #$40 + #$3F + #$34 + #$35 + #$36 + #$37 + #$38 + #$39 + #$3A + #$3B + #$3C
    + #$3D + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40 + #$00 + #$01 + #$02 + #$03
    + #$04 + #$05 + #$06 + #$07 + #$08 + #$09 + #$0A + #$0B + #$0C + #$0D + #$0E + #$0F
    + #$10 + #$11 + #$12 + #$13 + #$14 + #$15 + #$16 + #$17 + #$18 + #$19 + #$40 + #$40
    + #$40 + #$40 + #$40 + #$40 + #$1A + #$1B + #$1C + #$1D + #$1E + #$1F + #$20 + #$21
    + #$22 + #$23 + #$24 + #$25 + #$26 + #$27 + #$28 + #$29 + #$2A + #$2B + #$2C + #$2D
    + #$2E + #$2F + #$30 + #$31 + #$32 + #$33 + #$40 + #$40 + #$40 + #$40 + #$40 + #$40;



{==============================================================================}

function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
var
  x, y, lv: Integer;
  d: integer;
  dl: integer;
  c: byte;
  p: integer;
begin
  lv := Length(Value);
  SetLength(Result, lv);
  x := 1;
  dl := 4;
  d := 0;
  p := 1;
  while x <= lv do
  begin
    y := Ord(Value[x]);
    if y in [33..127] then
      c := Ord(Table[y - 32])
    else
      c := 64;
    Inc(x);
    if c > 63 then
      continue;
    d := (d shl 6) or c;
    dec(dl);
    if dl <> 0 then
      continue;
    Result[p] := AnsiChar((d shr 16) and $FF);
    inc(p);
    Result[p] := AnsiChar((d shr 8) and $FF);
    inc(p);
    Result[p] := AnsiChar(d and $FF);
    inc(p);
    d := 0;
    dl := 4;
  end;
  case dl of
    1:
      begin
        d := d shr 2;
        Result[p] := AnsiChar((d shr 8) and $FF);
        inc(p);
        Result[p] := AnsiChar(d and $FF);
        inc(p);
      end;
    2:
      begin
        d := d shr 4;
        Result[p] := AnsiChar(d and $FF);
        inc(p);
      end;
  end;
  SetLength(Result, p - 1);
end;

{==============================================================================}

function Encode3to4(const Value, Table: AnsiString): AnsiString;
var
  c: Byte;
  n, l: Integer;
  Count: Integer;
  DOut: array[0..3] of Byte;
begin
  setlength(Result, ((Length(Value) + 2) div 3) * 4);
  l := 1;
  Count := 1;
  while Count <= Length(Value) do
  begin
    c := Ord(Value[Count]);
    Inc(Count);
    DOut[0] := (c and $FC) shr 2;
    DOut[1] := (c and $03) shl 4;
    if Count <= Length(Value) then
    begin
      c := Ord(Value[Count]);
      Inc(Count);
      DOut[1] := DOut[1] + (c and $F0) shr 4;
      DOut[2] := (c and $0F) shl 2;
      if Count <= Length(Value) then
      begin
        c := Ord(Value[Count]);
        Inc(Count);
        DOut[2] := DOut[2] + (c and $C0) shr 6;
        DOut[3] := (c and $3F);
      end
      else
      begin
        DOut[3] := $40;
      end;
    end
    else
    begin
      DOut[2] := $40;
      DOut[3] := $40;
    end;
    for n := 0 to 3 do
    begin
      if (DOut[n] + 1) <= Length(Table) then
      begin
        Result[l] := Table[DOut[n] + 1];
        Inc(l);
      end;
    end;
  end;
  SetLength(Result, l - 1);
end;

{==============================================================================}

function DecodeBase64(const Value: AnsiString): AnsiString;
begin
  Result := Decode4to3Ex(Value, ReTableBase64);
end;

{==============================================================================}

function EncodeBase64(const Value: AnsiString): AnsiString;
begin
  Result := Encode3to4(Value, TableBase64);
end;

{==============================================================================}



function WrapForUnit(inp: string): string;
var i: integer;
const LL = 80;
begin
  Result := 'Const TestC=';
  for i := 0 to (Length(inp) div LL) do
    Result := Result + '''' + Copy(inp, i * LL, LL - byte(i = 0)) + '''+'#13#10;
  Result[length(Result) - 2] := ';';
end;


function EncodeFileForUnit(FileName: string): string;
var strm: TMemoryStream;
  Str: string;
begin
  Strm := TMemoryStream.Create;
  Strm.LoadFromFile(FileName);
  Strm.Position := 0;
  SetLength(Str, Strm.size);
  Move(Strm.memory^, Str[1], Strm.size);
  Result := WrapForUnit(EncodeBase64(Str));
  Strm.free;
end;

procedure DecodeFileFromUnit(Inp: string; Strm: TMemoryStream);
var tmp: string;
begin
  tmp := DecodeBase64(Inp);
  Strm.Clear;
  Strm.SetSize(Length(tmp) + 1);
  Strm.Position := 0;
  Move(tmp[1], strm.memory^, Strm.size);
  Strm.Position := 0;
end;


end.