uuenc.pas

boomerang library 5.11 internet ed

{ Copyright (c) 1999, 2000 by Mandys Tomas - MandySoft }
{ email: [e-mail] }
{ URL: http://www.2p.cz }

unit UUEnc;

{ UUEnc.htx }

interface
uses
  Classes;

type
  TCodeType = (uuUU, uuBase64, uuQuoted);
  TProgressEvent = procedure (aPos, aMax: Longint) of object;

{
procedure UUDecode(const aFrom, aTo: string; aKind: TCodeType);
procedure UUEncode(const aFrom, aTo: string; aKind: TCodeType);

procedure UUDecode(const aFrom, aTo: string);
procedure UUEncode(const aFrom, aTo: string);
procedure Base64Decode(const aFrom, aTo: string);
procedure Base64Encode(const aFrom, aTo: string);
procedure QuotedDecode(const aFrom, aTo: string);
procedure QuotedEncode(const aFrom, aTo: string);
}

procedure _UUEncode(const S1, S2: TStream; aKind: TCodeType; aProgressEvent: TProgressEvent);
procedure _UUDecode(const S1, S2: TStream; aKind: TCodeType; aProgressEvent: TProgressEvent);

implementation
uses
  {$IFNDEF LINUX}
  WinTypes,
  {$ENDIF}
  SysUtils;

const
  _Code64: string[64]=('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
{  _UUCode: string[64]=(' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); }


const
  TripleQuad = [uuBase64, uuUU];

procedure _UUEncode;
var
  J, N: Integer;
  Triple: string[3];
  Sg: string;
const
  LinLen = 75;
begin
  while S1.Position < S1.Size do
  begin
    if @aProgressEvent <> nil then
      aProgressEvent(S1.Position, S1.Size);
    N:= 0;
    Sg:= '';
    while (N < LinLen) and (S1.Position < S1.Size) do
    begin
      if aKind = uuQuoted then
      begin
        S1.ReadBuffer(Triple[1], 1);
        if Triple[1] in [#0..#32, '=', #128..#255] then
          begin
            Sg:= Format('%s=%.2x', [Sg, Byte(Triple[1])]);
            Inc(N, 2);
          end
        else
          Sg:= Sg+Triple[1];
        Inc(N);
      end else  { next code kind }
      if aKind in TripleQuad then
      begin
        J:= S1.Size-S1.Position;
        if J > SizeOf(Triple)-1 then
          J:= SizeOf(Triple)-1;
        SetLength(Triple, J);
        S1.ReadBuffer(Triple[1], Length(Triple));

        if N = 0 then
          Sg:= ' ';
        if aKind = uuUU then
        begin
          Sg:= Sg+ Chr(Ord(' ')+(Ord(Triple[1]) shr 2));
          Sg:= Sg+ Chr(Ord(' ')+(Ord(Triple[1]) and $03) shl 4 + (Ord(Triple[2]) shr 4));
          Sg:= Sg+ Chr(Ord(' ')+(Ord(Triple[2]) and $0F) shl 2 + (Ord(Triple[3]) shr 6));
          Sg:= Sg+ Chr(Ord(' ')+(Ord(Triple[3]) and $3F));
          Byte(Sg[1]):= Byte(Sg[1])+Length(Triple);
        end else
        if aKind = uuBase64 then
        begin
          Sg:= Sg+ _Code64[(Ord(Triple[1]) shr 2)+1];
          Sg:= Sg+ _Code64[(Ord(Triple[1]) and $03) shl 4 + (Ord(Triple[2]) shr 4)+1];
          if Length(Triple) > 1 then Sg:= Sg+ _Code64[(Ord(Triple[2]) and $0F) shl 2 + (Ord(Triple[3]) shr 6)+1]
                                else Sg:= Sg+ '=';
          if Length(Triple) > 2 then Sg:= Sg+ _Code64[(Ord(Triple[3]) and $3F)+1]
                                else Sg:= Sg+ '=';
        end;
        Inc(N, 4);
      end;
    end;
    Sg:= Sg+#13#10;
    S2.WriteBuffer(Sg[1], Length(Sg));
  end;
end;

procedure _UUDecode;
var
  N: Integer;
  Quad: string[4];
  Sg: string;
  C: Char;
begin
  N:= 0;
  while S1.Position < S1.Size do
  begin
    if @aProgressEvent <> nil then
      aProgressEvent(S1.Position, S1.Size);
    Sg:= '';
    if aKind = uuQuoted then
    begin
      S1.ReadBuffer(Quad[1], 1);
      if Quad[1] = '=' then
        begin
          if S1.Position+2 <= S1.Size then
          begin
            S1.ReadBuffer(Quad[1], 2);
            SetLength(Quad, 2);
            if (Quad[1] in ['A'..'F','0'..'9']) and (Quad[2] in ['A'..'F','0'..'9']) then
              Sg:= Char(StrToInt('$'+Quad));
          end;
        end
      else
        if Quad[1] >= ' ' then
          Sg:= Sg+Quad[1];
    end else { next code kind }
    begin
      Quad:= '';
      repeat
        S1.ReadBuffer(C, SizeOf(C));
        if (C > ' ') or (N > 0) then
        begin
          if aKind = uuUU then
            C:= Chr(Ord(C) - Ord(' '))
          else
            begin
              case C of
                'A'..'Z': Dec(Byte(C), 65);  {<65..90>  --> <0..25>}
                'a'..'z': Dec(Byte(C), 71);  {<97..122>  --> <26..51>}
                '0'..'9': Inc(Byte(C), 4);   {<48..57>  --> <52..61>}
                '+': C:= #62;{43}
                '/': C:= #63;{47}
              else
                {'=': }C:= #64;{61}
              end;
            end;
          if (N = 0) and (aKind = uuUU) then
            N:= Ord(C)
          else
            begin
              Quad:= Quad+C;
            end;
        end;
      until (S1.Position >= S1.Size) or (Length(Quad) >= SizeOf(Quad)-1);

      if N > 0 then
        Dec(N, 3);
      if aKind = uuBase64 then
      begin
        while (Quad <> '') and (Quad[Length(Quad)] = #64) do
          SetLength(Quad, Length(Quad)-1);
      end;
      if Length(Quad) > 0 then
        Sg:= Sg+ Chr(Byte(Quad[1]) shl 2 + Byte(Quad[2]) shr 4);
      if Length(Quad) > 2 then
        Sg:= Sg+ Chr(Byte(Quad[2]) shl 4 + Byte(Quad[3]) shr 2);
      if Length(Quad) > 3 then
        Sg:= Sg+ Chr(Byte(Quad[3]) shl 6 + Byte(Quad[4]));
    end;
    S2.WriteBuffer(Sg[1], Length(Sg));
  end;
end;

end.


procedure UUEncode;
var
  S1, S2: TStream;
  Sg: string;
  N, J: Integer;
  B: array[1..3] of Byte;
const
  LinLen = SizeOf(B)* 15;
begin
  S1:= TFileStream.Create(aFrom, fmOpenRead);
  try
    S2:= TFileStream.Create(aTo, fmCreate);
    try
      while S1.Position < S1.Size do
      begin
        N:= 0;
        Sg:= '';
        while (N < LinLen) and (S1.Position < S1.Size) do
        begin
          FillChar(B, SizeOf(B), ' ');
          J:= S1.Size-S1.Position;
          if J > SizeOf(B) then
            J:= SizeOf(B);
          Inc(N, J);
          S1.ReadBuffer(B, J);
          Sg:= Sg+ Chr(Ord(' ')+(B[1] shr 2));
          Sg:= Sg+ Chr(Ord(' ')+(B[1] and $03) shl 4 + (B[2] shr 4));
          Sg:= Sg+ Chr(Ord(' ')+(B[2] and $0F) shl 2 + (B[3] shr 6));
          Sg:= Sg+ Chr(Ord(' ')+(B[3] and $3F));
        end;
        Sg:= Chr(N+Ord(' '))+Sg+#13#10;
        S2.WriteBuffer(Sg[1], Length(Sg));
      end;
    finally
      S2.Free;
    end;
  finally
    S1.Free;
  end;
end;

const
  _Code64: string[64]=('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');

procedure Base64Decode;
var
  S1, S2: TStream;
  A1: array[1..4] of Byte;
  B1: array[1..3] of Byte;
  Byte_Ptr,Real_Bytes: Integer;
  B: Byte;
  C: Char;
begin
  S1:= TFileStream.Create(aFrom, fmOpenRead);
  try
    S2:= TFileStream.Create(aTo, fmCreate);
    try
      Byte_Ptr:= Low(A1);
      while S1.Position < S1.Size do
      begin
        S1.ReadBuffer(C, SizeOf(C));
        if C > ' ' then
        begin
          case C of
            'A'..'Z': B:=Ord(C)-65;  {<65..90>  --> <0..25>}
            'a'..'z': B:=Ord(C)-71;  {<97..122>  --> <26..51>}
            '0'..'9': B:=Ord(C)+4;   {<48..57>  --> <52..61>}
            '+': B:=62;{43}
            '/': B:=63;{47}
          else
            {'=': }B:=64;{61}
          end;
          A1[Byte_Ptr]:= B;
          Inc(Byte_Ptr);
          if Byte_Ptr=High(A1)+1 then
          begin
            Byte_ptr:=Low(A1);
            Real_Bytes:=3;
            if A1[1]=64 then Real_Bytes:=0;
            if A1[3]=64 then
            begin
              a1[3]:=0;
              a1[4]:=0;
              real_bytes:=1;
            end;
            if a1[4]=64 then
            begin
              a1[4]:=0;
              real_bytes:=2;
            end;
            b1[1]:=a1[1]*4+(a1[2] div 16);
            b1[2]:=(a1[2] mod 16)*16+(a1[3]div 4);
            b1[3]:=(a1[3] mod 4)*64 +a1[4];
            S2.WriteBuffer(b1, real_bytes);
          end;
        end;
      end;
    finally
      S2.Free;
    end;
  finally
    S1.Free;
  end;
end;

procedure Base64Encode;
var
  S1, S2: TStream;
  Sg: string;
  N, J: Integer;
  B: array[1..3] of Byte;
const
  LinLen = SizeOf(B)* 20;
begin
  S1:= TFileStream.Create(aFrom, fmOpenRead);
  try
    S2:= TFileStream.Create(aTo, fmCreate);
    try
      while S1.Position < S1.Size do
      begin
        N:= 0;
        Sg:= '';
        while (N < LinLen) and (S1.Position < S1.Size) do
        begin
          J:= S1.Size-S1.Position;
          if J > SizeOf(B) then
            J:= SizeOf(B);
          Inc(N, J);
          S1.ReadBuffer(B, J);
          Sg:= Sg+ _Code64[(B[1] shr 2)+1];
          Sg:= Sg+ _Code64[(B[1] and $03) shl 4 + (B[2] shr 4)+1];
          if J > 1 then Sg:= Sg+ _Code64[(B[2] and $0F) shl 2 + (B[3] shr 6)+1]
                   else Sg:= Sg+ '=';
          if J > 2 then Sg:= Sg+ _Code64[(B[3] and $3F)+1]
                   else Sg:= Sg+ '=';
        end;
        Sg:= Sg+#13#10;
        S2.WriteBuffer(Sg[1], Length(Sg));
      end;
    finally
      S2.Free;
    end;
  finally
    S1.Free;
  end;
end;

procedure QuotedEncode;
var
  S1, S2: TStream;
  Sg: string;
  C: Char;
const
  LinLen = 70;
begin
  S1:= TFileStream.Create(aFrom, fmOpenRead);
  try
    S2:= TFileStream.Create(aTo, fmCreate);
    try
      while S1.Position < S1.Size do
      begin
        Sg:= '';
        while (Length(Sg) <= LinLen) and (S1.Position < S1.Size) do
        begin
          S1.ReadBuffer(C, SizeOf(C));
          if C in [#0..#32, '=', #128..#255] then
            Sg:= Format('%s=%.2x', [Sg, Byte(C)])
          else
            Sg:= Sg+C;
        end;
        if S1.Position = S1.Size then
          Sg:= Sg+#0;
        S2.WriteBuffer(Sg[1], Length(Sg));
      end;
    finally
      S2.Free;
    end;
  finally
    S1.Free;
  end;
end;

procedure QuotedDecode;
var
  S1, S2: TStream;
  Sg: string;
begin
  S1:= TFileStream.Create(aFrom, fmOpenRead);
  try
    S2:= TFileStream.Create(aTo, fmCreate);
    try
      while S1.Position < S1.Size do
      begin
        Sg:= ' ';
        S1.ReadBuffer(Sg[1], Length(Sg));
        if Sg = '=' then
        begin
          Sg:= '  ';
          S1.ReadBuffer(Sg[1], Length(Sg));
          if (Sg[1] in ['A'..'F','0'..'9']) and (Sg[2] in ['A'..'F','0'..'9']) then
            Sg:= Char(StrToNum(HexPrefix+Sg))
          else
            Sg:= '';
        end;
        S2.WriteBuffer(Sg[1], Length(Sg));
      end;
    finally
      S2.Free;
    end;
  finally
    S1.Free;
  end;
end;