A função abaixo existe há muito tempo na Internet, como não sei seu verdadeiro desenvolvedor não colocarei os créditos.
Ocorre que realizei algumas modificações para reparar algumas pequenas falhas, deixando portanto o código mais utiizável.
O ponto forte do respectivo código é que realiza criptografia e também descriptografia, ou seja, faz e desfaz o processo criptográfico.
function crypt(Action, Src: String): String;
var
KeyLen, KeyPos, OffSet, SrcPos, SrcAsc, TmpSrcAsc, Range: Integer;
Dest, Key: String;
begin
result := '';
if Src <> '' then
begin
Key := 'CHAVEDECRIPTOGRAFIA';
Dest := '';
KeyLen := Length(Key);
KeyPos := 0;
SrcPos := 0;
SrcAsc := 0;
Range := 256;
if (UpperCase(Action) = 'C') then
begin
Randomize;
OffSet := Random(Range);
Dest := Format('%1.2x',[OffSet]);
for SrcPos := 1 to Length(Src) do
begin
Application.ProcessMessages;
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
else if (UpperCase(Action) = '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;
end;
Para utilizá-lo, o usuário poderá com três Edits e um botão, fazer o seguinte, no evento OnClick do botão
Edit2.Text := crypt('C', Edit1.Text);
Edit3.Text := crypt('D', Edit2.Text);
Observe que a letra C, encripta (crypt), enquanto a letra D desencript (decrypt).
