Funcao - criptografar

function xCrypt(const A: Char; const Src, Key: string): string;

var

  KeyLen    : Integer;

  KeyPos    : Integer;

  offset    : Integer;

  SrcPos    : Integer;

  SrcAsc    : Integer;

  TmpSrcAsc : Integer;

  Range     : Integer;

begin

  Result := '';

  KeyLen := Length(Key);

  KeyPos := 0;

  Range  := 256;

  if A = 'E' then

  try

    Randomize;

    offset := Random(Range);

    Result := format('%1.2x',[offset]);

    for SrcPos := 1 to Length(Src) do

    begin

      SrcAsc := (Ord(Src[SrcPos]) + offset) MOD 255;

      if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;

      SrcAsc := SrcAsc xor Ord(Key[KeyPos]);

      Result := Result + Format('%1.2x',[SrcAsc]);

      offset := SrcAsc;

    end;

  except

    Result := 'Erro';

  end

  else

  try

    offset := StrToInt('$'+ copy(src,1,2));

    SrcPos := 3;

    repeat

      SrcAsc := StrToInt('$'+ copy(src,SrcPos,2));

      if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;

      TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);

      if TmpSrcAsc <= offset then

        TmpSrcAsc := 255 + TmpSrcAsc - offset

      else

        TmpSrcAsc := TmpSrcAsc - offset;

      Result := Result + chr(TmpSrcAsc);

      offset := srcAsc;

      SrcPos := SrcPos + 2;

    until SrcPos >= Length(Src);

  except

    Result := 'Erro';

  end;

end;

function Encrip(const S, Chave: string): string;

begin

  Result := xCrypt('E', S, Chave);

end;

function Decrip(const S, Chave: string): string;

begin

  Result := xCrypt('D', S, Chave);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  Memo1.Lines.Add(Encrip(Edit1.Text, 'Chave'));

end;