Here's something simple - you enter any string as your input string and it
always gives you a six digit number as the return variable. I don't know
how easy it would be to break. A colleague and I put it together a couple
of years ago.
It is only one way...
function Crypt(texti : string) : string;
var
t, tt, sana : Integer;
x1, x2, g : Double;
salasana2 : Double;
crypted, cr1, cr2 : string;
sana2, strTemp : string;
const
salasana = 'akeystring'; //something easily changeable which completely
changes the answer
begin
x1 := 0;
for t := 1 to Length(salasana) do begin
sana := Ord(salasana[t]);
x1 := x1 + sana;
end;
x1 := Int((x1 * 0.1) / 6);
salasana2 := x1;
g := 0;
for tt := 1 to Length(texti) do begin
sana := Ord(texti[tt]);
g := g + 1;
if g = 6 then g := 0;
x1 := 0;
if g = 0 then x1 := sana - (salasana2 - 2);
if g = 1 then x1 := sana + (salasana2 - 5);
if g = 2 then x1 := sana - (salasana2 - 4);
if g = 3 then x1 := sana + (salasana2 - 2);
if g = 4 then x1 := sana - (salasana2 - 3);
if g = 5 then x1 := sana + (salasana2 - 5);
x1 := x1 + g;
t := StrToInt(FloatToStr(X1));
crypted := crypted + Chr(t);
end;
sana2 := '';
for tt := 1 to Length(crypted) do begin
strTemp := IntToStr(Ord(crypted[tt]));
sana2 := sana2 + strTemp[Length(strTemp)];
end;
//*** make sana = 30 characters long
if Length(sana2) < 30 then begin
for tt := 1 to (30 - Length(sana2)) do begin
sana2 := sana2 + sana2[tt];
end;
end
else if Length(sana2) > 30 then begin
SetLength(sana2, 30);
end;
cr1 := '';
t := 1;
while t <= Length(sana2) do begin
strTemp := IntToHex(StrToInt(sana2[t] + sana2[t + 1]),1);
strTemp := IntToStr(Ord(strTemp[Length(strTemp)]));
cr1 := cr1 + strTemp[Length(strTemp)];
t := t + 2;
end;
t := 30;
while t > 1 do begin
cr2 := cr2 + sana2[t];
t := t - 2;
end;
x2 := StrToFloat(cr1) / StrToFloat(cr2);
strTemp := FloatToStr(x2);
for t := 9 to 14 do begin
Result := Result + strTemp[t];
end;
end;
---------------------------------------------------------------------------
New Zealand Delphi Users group - Delphi List - [EMAIL PROTECTED]
Website: http://www.delphi.org.nz
To UnSub, send email to: [EMAIL PROTECTED]
with body of "unsubscribe delphi"
Web Archive at: http://www.mail-archive.com/delphi%40delphi.org.nz/
