program bs64;
type
    Base64Collection = array [0..63] of char;
    ArrayOfBytes = array [1..4] of byte;
    Base64 = record
        bytes: ArrayOfBytes;
        mask, tail: byte;
        CountOfNotZeroBytes: integer;
    end;
    LOBNodePtr = ^LOBNode;
    LOBNode = record
        bs: Base64;
        next: LOBNodePtr;
    end;
    ListOfBytes = record
        first, last: LOBNodePtr;
    end;

procedure Base64Init(var bs: Base64);
var
    n: integer;
begin
    for n := 1 to 4 do
        bs.bytes[n] := 0;
     bs.mask := %11111111;
     bs.tail := 0;
     bs.CountOfNotZeroBytes := 0;
end;

procedure LOBInit(var list: ListOfBytes);
begin
    list.first := nil;
    list.last := nil;
end;

procedure LOBAdd(var list: ListOfBytes; bs: Base64);
var
    n: integer;
begin
    if list.first = nil then
    begin
        new(list.first);
        list.last := list.first;
    end
    else
    begin
        new(list.last^.next);
        list.last := list.last^.next;
    end;
    Base64Init(list.last^.bs);
    list.last^.bs.CountOfNotZeroBytes := bs.CountOfNotZeroBytes;
    for n := 1 to bs.CountOfNotZeroBytes do
        list.last^.bs.bytes[n] := bs.bytes[n];
    list.last^.next := nil;
end;

function GetBase64Chars: Base64Collection;
var
    i, j, k: integer;
    chars: string = '';
begin
    for i := ord('A') to ord('Z') do
        chars += chr(i);
    for j := ord('a') to ord('z') do
        chars += chr(j);
    for k := ord('0') to ord('9') do
        chars += chr(k);
    chars += '+/=';
    GetBase64Chars := chars;
end;

procedure SplitFirstByte(var bs: Base64);
begin
    bs.tail := bs.mask shr 6;
    bs.tail := bs.tail and bs.bytes[1];
    bs.tail := bs.tail shl 4;
    bs.bytes[1] := bs.bytes[1] shr 2;
end;

procedure SplitSecondByte(var bs: Base64);
var
    mask: byte;
begin
    mask := bs.mask shr 4;
    mask := mask and bs.bytes[2];
    mask := mask shl 2;
    bs.bytes[2] := (bs.bytes[2] shr 4) or bs.tail;
    bs.tail := mask;
end;

procedure SplitThirdByte(var bs: Base64);
var
    mask: byte;
begin
    mask := bs.mask shr 2;
    mask := mask and bs.bytes[3];
    bs.bytes[3] := (bs.bytes[3] shr 6) or bs.tail;
    bs.tail := mask;
end;

procedure SplitBytes(var bs: Base64);
begin
    bs.mask := %11111111;
    SplitFirstByte(bs);
    SplitSecondByte(bs);
    SplitThirdByte(bs);
    bs.bytes[4] := bs.tail;
end;

procedure ResetThirdByte(var bs: Base64);
begin
    bs.tail := bs.bytes[3] shr 2;
    bs.bytes[3] := (bs.bytes[3] shl 6) or bs.bytes[4];
end;

procedure ResetSecondByte(var bs: Base64);
var
    mask: byte;
begin
    mask := bs.bytes[2] shr 4;
    bs.bytes[2] := (bs.bytes[2] shl 4) or bs.tail;
    bs.tail := mask;
end;

procedure ResetFirstByte(var bs: Base64);
begin
    bs.bytes[1] := (bs.bytes[1] shl 2) or bs.tail;
end;

procedure ResetBytes(var bs: Base64);
begin
    ResetThirdByte(bs);
    ResetSecondByte(bs);
    ResetFirstByte(bs);
end;

procedure GetBytes(var list: ListOfBytes; var f: file);
const
    BufSize = 3;
var    
    buf: array [1..BufSize] of byte;
    res, n: integer;
    bs: Base64;
begin
    while not eof(f) do
    begin
        Base64Init(bs);
        BlockRead(f, buf, BufSize, res);
        for n := 1 to res do
            bs.bytes[n] := buf[n];
        bs.CountOfNotZeroBytes := res;
        LOBAdd(list, bs);
    end;
    close(f);
end;

procedure GetEncodeBytes(var list: ListOfBytes; var f: file);
const
    BufSize = 4;
var    
    buf: array [1..BufSize] of byte;
    res, n: integer;
    bs: Base64;
begin
    while not eof(f) do
    begin
        Base64Init(bs);
        BlockRead(f, buf, BufSize, res);
        for n := 1 to res do
        begin
            bs.bytes[n] := buf[n];
            if chr(bs.bytes[n]) = '=' then
                res -= 1;
        end;
        bs.CountOfNotZeroBytes := res;
        LOBAdd(list, bs);
    end;
    close(f);
end;

procedure Base64Encode(var list: ListOfBytes);
var
    NodePtr: LOBNodePtr;
begin
    NodePtr := list.first; 
    while NodePtr <> nil do
    begin
        SplitBytes(NodePtr^.bs);
        { every n bytes - n+1 bytes after split }
        case NodePtr^.bs.CountOfNotZeroBytes of
            1: NodePtr^.bs.CountOfNotZeroBytes := 2;
            2: NodePtr^.bs.CountOfNotZeroBytes := 3;
            3: NodePtr^.bs.CountOfNotZeroBytes := 4;
        end;
        NodePtr := NodePtr^.next;
    end;
end;

procedure Base64Decode(var list: ListOfBytes);
var
    NodePtr: LOBNodePtr;
begin
    NodePtr := list.first; 
    while NodePtr <> nil do
    begin
        ResetBytes(NodePtr^.bs);
        NodePtr^.bs.CountOfNotZeroBytes -= 1;
        NodePtr := NodePtr^.next;
    end;
end;

procedure LOBPrint(var list: ListOfBytes);
var
    NodePtr: LOBNodePtr;
    n: integer;
begin
    NodePtr := list.first; 
    while NodePtr <> nil do
    begin
        for n := 1 to NodePtr^.bs.CountOfNotZeroBytes do
            write(NodePtr^.bs.bytes[n], ' ');
        NodePtr := NodePtr^.next;
    end;
    writeln;
end;

procedure LOBSave(var list: ListOfBytes; var f: file);
const
    BufSize = 1;
var
    NodePtr: LOBNodePtr;
    n, res: integer;
begin
    NodePtr := list.first; 
    while NodePtr <> nil do
    begin
        for n := 1 to NodePtr^.bs.CountOfNotZeroBytes do
            BlockWrite(f, NodePtr^.bs.bytes[n], BufSize, res);
        NodePtr := NodePtr^.next;
    end;
    close(f);
end;

procedure LOBSaveText(var list: ListOfBytes; var f: text);
const
    BufSize = 1;
var
    NodePtr: LOBNodePtr;
    n, res: integer;
begin
    NodePtr := list.first;
    res := 0;
    while NodePtr <> nil do
    begin
        for n := 1 to NodePtr^.bs.CountOfNotZeroBytes do
            write(f, NodePtr^.bs.bytes[n], BufSize, res);
        NodePtr := NodePtr^.next;
    end;
    close(f);
end;

procedure CheckPadding(var list: ListOfBytes; var f: file);
type
    ArrayWithPad = array [1..3] of char;
var
    n, res: integer;
    NodePtr: LOBNodePtr;
    buf: ArrayWithPad = ('=', '=', #10);
begin
    NodePtr := list.first;
    while NodePtr^.next <> nil do
        NodePtr := NodePtr^.next;
    if NodePtr^.bs.CountOfNotZeroBytes = 4 then
        BlockWrite(f, buf[3], 1, res);
    if NodePtr^.bs.CountOfNotZeroBytes = 3 then
    begin
        BlockWrite(f, buf[1], 1, res);
        BlockWrite(f, buf[3], 1, res);
    end;
    if NodePtr^.bs.CountOfNotZeroBytes = 2 then
    begin
        for n := 1 to 3 do
            BlockWrite(f, buf[n], 1, res);
    end;
    close(f);
end;

procedure MatchEveryByteWithChar(var list: ListOfBytes; var f: file);
var
    n, res: integer;
    NodePtr: LOBNodePtr;
    b64c: Base64Collection;
begin
    b64c := GetBase64Chars;
    NodePtr := list.first;
    while NodePtr <> nil do
    begin
        for n := 1 to NodePtr^.bs.CountOfNotZeroBytes do
            BlockWrite(f, b64c[NodePtr^.bs.bytes[n]], 1, res);
        NodePtr := NodePtr^.next;
    end;
    CheckPadding(list, f);
end;

function MatchCharWithBase64Table(ch: char): integer;
var
    n: integer;
    b64c: Base64Collection;
begin
    b64c := GetBase64Chars;
    for n := 1 to length(b64c) do
        if ch = b64c[n] then
            MatchCharWithBase64Table := n;
end;

procedure MatchEveryCharWithByte(var list: ListOfBytes);
var
    n, code: integer;
    NodePtr: LOBNodePtr;
    ch: char;
begin
    NodePtr := list.first;
    while NodePtr <> nil do
    begin
        for n := 1 to NodePtr^.bs.CountOfNotZeroBytes do
        begin
            ch := chr(NodePtr^.bs.bytes[n]);
            write; { [ATTENTION!] for flush output }
            code := MatchCharWithBase64Table(ch);
            NodePtr^.bs.bytes[n] := code;
        end;
        NodePtr := NodePtr^.next;
    end;
end;

procedure Decode64(var list: ListOfBytes; fsrcname, fdstname: string);
var
    fsrc, fdst: file;
begin
    assign(fsrc, fsrcname);
    reset(fsrc, 1);
    GetEncodeBytes(list, fsrc);
    MatchEveryCharWithByte(list);
    Base64Decode(list);
    assign(fdst, fdstname);
    rewrite(fdst, 1);
    LOBSave(list, fdst);
end;

procedure Encode64(var list: ListOfBytes; fsrcname, fdstname: string);
var
    fsrc, fdst: file;
begin
    assign(fsrc, fsrcname);
    assign(fdst, fdstname);
    reset(fsrc, 1);
    rewrite(fdst, 1);
    GetBytes(list, fsrc);
    Base64Encode(list);
    MatchEveryByteWithChar(list, fdst);
end;

var
    enc, dec: ListOfBytes;
begin
    if ParamStr(1) = '' then
    begin
        writeln(ErrOutput, 'Input is empty! Exit...');
        exit;
    end;
    if ParamStr(1) = '-d' then
    begin
        LOBInit(dec);
        Decode64(dec, ParamStr(2), ParamStr(3));
        exit;
    end;
    LOBInit(enc);
    Encode64(enc, ParamStr(1), ParamStr(2));
end.
