CODE
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:
CODE
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.