Ajuda Decypt!

[gl0w]

Olá pessoal, desculpe se postei no local errado, sou novo aqui :P

Meu problema é o seguinte, sou leigo em delphi, e gostaria de saber se existe um decrypt e encrypt para esse tipo de criptografia.

Recipients.EMailAddresses := esconde('tzvˆ}ƒ|†HLZ‚‰~‡‹N„‘');

Agradeço desde já!

[Jhonas]

function TPasswordDlg.Encrypt;
begin
  S2:=Crypt('E', S1, key);
end;

function TPasswordDlg.Decrypt;
begin
  S2:=Crypt('D', S1, key);
end;

function TPasswordDlg.Crypt(Action, Src, Key : String) : String;
var
   KeyLen    : Integer;
   KeyPos    : Integer;
   offset    : Integer;
   dest      : string;
   SrcPos    : Integer;
   SrcAsc    : Integer;
   TmpSrcAsc : Integer;
   Range     : Integer;
begin
     dest:='';
     KeyLen:=Length(Key);
     KeyPos:=0;
     SrcPos:=0;
     SrcAsc:=0;
     Range:=256;
     if Action = UpperCase('E') then
     begin
          Randomize;
          offset:=Random(Range);
          dest:=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]);
               dest:=dest + format('%1.2x',[SrcAsc]);
               offset:=SrcAsc;
          end;
     end;
     if Action = UpperCase('D') then
     begin
          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;
                dest := dest + chr(TmpSrcAsc);
                offset:=srcAsc;
                SrcPos:=SrcPos + 2;
          until SrcPos >= Length(Src);
     end;
     Result:=dest;
end;

onde Key := 'tzvˆ}ƒ|†HLZ‚‰~‡‹N„‘' Voce pode usar essas funções para encripitar / desencripitar textos de email, mas quem recebe tambem tem que ter o mesmo programa para desencripitar a mensagem e poder ler, onde a chave (Key) teria que ser a mesma. Exemplo de como usar:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    Memo3: TMemo;
    function Crypt(Action, Src, Key : String) : String;
    function Encrypt : string;
    function Decrypt : string;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  s1, s2, Key, action, src : string;
implementation

{$R *.DFM}


function TForm1.Encrypt;
begin
  S2:=Crypt('E', S1, key);
end;

function TForm1.Decrypt;
begin
  S2:=Crypt('D', S1, key);
end;

function TForm1.Crypt(Action, Src, Key : String) : String;
var
   KeyLen    : Integer;
   KeyPos    : Integer;
   offset    : Integer;
   dest      : string;
   SrcPos    : Integer;
   SrcAsc    : Integer;
   TmpSrcAsc : Integer;
   Range     : Integer;
begin
     dest:='';
     KeyLen:=Length(Key);
     KeyPos:=0;
     SrcPos:=0;
     SrcAsc:=0;
     Range:=256;
     if Action = UpperCase('E') then
     begin
          Randomize;
          offset:=Random(Range);
          dest:=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]);
               dest:=dest + format('%1.2x',[SrcAsc]);
               offset:=SrcAsc;
          end;
     end;
     if Action = UpperCase('D') then
     begin
          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;
                dest := dest + chr(TmpSrcAsc);
                offset:=srcAsc;
                SrcPos:=SrcPos + 2;
          until SrcPos >= Length(Src);
     end;
     Result:=dest;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // ecripitar o texto de um memo

   Key := 'tzvˆ}ƒ|†HLZ‚‰~‡‹N„‘';
   s1 := memo1.Lines.Text;
   Encrypt;
   memo2.Clear;
   memo2.Lines.Text := s2;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   // desnecripitar o texto de um memo encripitado

   Key := 'tzvˆ}ƒ|†HLZ‚‰~‡‹N„‘';
   s1 := memo2.Lines.Text;
   Decrypt;
   memo3.Clear;
   memo3.Lines.Text := s2;
end;

end.

Editado Setembro 18, 2007 por Jhonas