{ -------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                    }
{ (c) 1998, 2000 by Robert Boeck                                       }
{ (c) 2000-2001 OpenXP-Team                                            }
{ (c) 2002-2024 FreeXP, http://www.freexp.de                           }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.          }
{                                                                      }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der      }
{ Datei SLIZENZ.TXT oder auf http://www.crosspoint.de/oldlicense.html. }
{ -------------------------------------------------------------------- }

{$I XPDEFINE.INC }
{$F+,O+}

unit encoder;

interface

type str90=string[90];
     tbytestream=array[0..63] of byte;

procedure encode_base64(var bytestream:tbytestream;len:word;
                        var encoded:str90);
procedure encode_UU(var bytestream:tbytestream;len:word;
                    var encoded:str90);
function Cancelkey(msgid:string):string;
function Cancellock(msgid:string):string;

implementation

uses sha1,hash,xp0;

type tbase64alphabet=array[0..63] of char;

const cbase64alphabet:tbase64alphabet=
      'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

procedure encode_base64(var bytestream:tbytestream;len:word;
                        var encoded:str90);
  var i,j,l:word;
      b:array[0..3] of byte;
  begin
    encoded:='';
    if len=0 then exit;
    for i:=len to sizeof(tbytestream)-1 do bytestream[i]:=0;
    l:=0;
    for i:=0 to (len-1) div 3 do begin
      inc(l,3);
      if l>len then l:=len;
      b[0]:=(bytestream[i*3] and $fc) shr 2;
      b[1]:=((bytestream[i*3] and $03) shl 4)
            or ((bytestream[i*3+1] and $f0) shr 4);
      b[2]:=((bytestream[i*3+1] and $0f) shl 2)
            or ((bytestream[i*3+2] and $c0) shr 6);
      b[3]:=bytestream[i*3+2] and $3f;
      for j:=0 to (l-1) mod 3+1 do
       encoded:=encoded+cbase64alphabet[b[j]];
      for j:=1 to 2-(l-1) mod 3 do
       encoded:=encoded+'=';
    end;
  end;

procedure encode_UU(var bytestream:tbytestream;len:word;
                    var encoded:str90);
  var i,j:word;
      b:array[0..3] of byte;
  begin
    encoded:='';
    if len=0 then exit;
    for i:=len to sizeof(tbytestream)-1 do bytestream[i]:=0;
    for i:=0 to (len-1) div 3 do begin
      b[0]:=(bytestream[i*3] and $fc) shr 2;
      b[1]:=((bytestream[i*3] and $03) shl 4)
            or ((bytestream[i*3+1] and $f0) shr 4);
      b[2]:=((bytestream[i*3+1] and $0f) shl 2)
            or ((bytestream[i*3+2] and $c0) shr 6);
      b[3]:=bytestream[i*3+2] and $3f;
      for j:=0 to 3 do begin
        if b[j]=0 then b[j]:=64;
        encoded:=encoded+char(b[j]+32);
      end;
    end;
    encoded:=char(len+32)+encoded;
  end;

function Cancelkey(msgid:string):string;
  var context   : THashContext;
      digest    : TSHA1Digest;
      digest2   : tbytestream;
      sha1buf   : array[1..255] of byte;
      l         : byte;
      source    : string;

  begin
    SHA1Init(context);
    source:=msgid+sitekey;
    l:=length(source);
    move(source[1],sha1buf[1],l);
    SHA1Update(context,@sha1buf,l);
    SHA1Final(context,digest);
    move(digest[1],digest2[1],20);
    encode_base64(digest2,20,source);
    Cancelkey:=source;
  end;

function Cancellock(msgid:string):string;
  var context   : THashContext;
      digest    : TSHA1Digest;
      digest2   : tbytestream;
      sha1buf   : array[1..255] of byte;
      l         : byte;
      source    : string;
  begin
    SHA1Init(context);
    source:=Cancelkey(msgid);
    l:=length(source);
    move(source[1],sha1buf[1],l);
    SHA1Update(context,@sha1buf,l);
    SHA1Final(context,digest);
    move(digest[1],digest2[1],20);
    encode_base64(digest2,20,source);
    Cancellock:='sha1:'+source;
  end;

end.
