unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
Button2: TButton;
Edit3: TEdit;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
Function EncrypKey (Src:String;
Key:String):string;
var
idx :integer;
KeyLen :Integer;
KeyPos :Integer;
offset :Integer;
dest :string;
SrcPos :Integer;
SrcAsc :Integer;
TmpSrcAsc :Integer;
Range :Integer;
begin
KeyLen:=Length(Key);
if KeyLen = 0 then
key:='Think Space';
KeyPos:=0;
SrcPos:=0;
SrcAsc:=0;
Range:=256;
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;
Result:=Dest;
end;
//解密函数
Function UncrypKey (Src:String;
Key:String):string;
var
idx :integer;
KeyLen :Integer;
KeyPos :Integer;
offset :Integer;
dest :string;
SrcPos :Integer;
SrcAsc :Integer;
TmpSrcAsc :Integer;
Range :Integer;
begin
KeyLen:=Length(Key);
if KeyLen = 0 then
key:='Think Space';
KeyPos:=0;
SrcPos:=0;
SrcAsc:=0;
Range:=256;
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);
Result:=Dest;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
edit2.Text :=EncrypKey(edit1.Text,'');
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
edit3.Text :=UncrypKey(edit2.Text ,'');
end;
end.
另外一个例子///////////////////////////////////////
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Editkey: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function encryptstr(const s:string;
skey:string):string;
function decryptstr(const s:string;
skey:string):string;
function myStrtoHex(s:string):string;
//原字符串转16进制字符串
function myHextoStr(S: string): string;//16进制字符串转原字符串
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.myStrtoHex(s: string): string;
var tmpstr:string;
i:integer;
begin
tmpstr := '';
for i:=1 to length(s)do
begin
tmpstr := tmpstr + inttoHex(ord(s),2);
end;
result := tmpstr;
end;
function TForm1.myHextoStr(S: string): string;
var hexS,tmpstr:string;
i:integer;
a:byte;
begin
hexS :=s;//应该是该字符串
if length(hexS) mod 2=1 then
begin
hexS:=hexS+'0';
end;
tmpstr:='';
for i:=1 to (length(hexS) div 2)do
begin
a:=strtoint('$'+hexS[2*i-1]+hexS[2*i]);
tmpstr := tmpstr+chr(a);
end;
result :=tmpstr;
end;
function TForm1.encryptstr(const s:string;
skey:string):string;
var
i,j: integer;
hexS,hexskey,midS,tmpstr:string;
a,b,c:byte;
begin
hexS :=myStrtoHex(s);
hexskey:=myStrtoHex(skey);
midS :=hexS;
for i:=1 to (length(hexskey) div 2) do
begin
if i<>1 then
midS:= tmpstr;
tmpstr:='';
for j:=1 to (length(midS) div 2)do
begin
a:=strtoint('$'+midS[2*j-1]+midS[2*j]);
b:=strtoint('$'+hexskey[2*i-1]+hexskey[2*i]);
c:=a xor b;
tmpstr := tmpstr+myStrtoHex(chr(c));
end;
end;
result := tmpstr;
end;
function TForm1.decryptstr(const s:string;
skey:string):string;
var
i,j: integer;
hexS,hexskey,midS,tmpstr:string;
a,b,c:byte;
begin
hexS :=s;//应该是该字符串
if length(hexS) mod 2=1 then
begin
showmessage('密文错误!');
exit;
end;
hexskey:=myStrtoHex(skey);
tmpstr :=hexS;
midS :=hexS;
for i:=(length(hexskey) div 2)do
wnto 1do
begin
if i<>(length(hexskey) div 2) then
midS:= tmpstr;
tmpstr:='';
for j:=1 to (length(midS) div 2)do
begin
a:=strtoint('$'+midS[2*j-1]+midS[2*j]);
b:=strtoint('$'+hexskey[2*i-1]+hexskey[2*i]);
c:=a xor b;
tmpstr := tmpstr+myStrtoHex(chr(c));
end;
end;
result := myHextoStr(tmpstr);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text :=encryptstr(Edit1.Text,Editkey.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Edit3.Text :=decryptstr(Edit2.Text,Editkey.Text);
end;
end.