字符列表的加解密函数!(200分)

  • 主题发起人 主题发起人 hying95
  • 开始时间 开始时间
H

hying95

Unregistered / Unconfirmed
GUEST, unregistred user!
字符列表中有中文,数字,字母等.加密后最好能把字符列表中的字符变成乱码.
要求把加密后的内容保存到文件后,重新读入能够被还原.
 
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdCoder, IdCoder3to4, IdCoderMIME, IdBaseComponent;
type
TForm1 = class(TForm)
IdEncoderMIME1: TIdEncoderMIME;
IdDecoderMIME1: TIdDecoderMIME;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
s: TStrings;
begin
s := TStringList.Create;
try
s.CommaText := IdEncoderMIME1.Encode(Edit1.Text);
s.SaveToFile('c:/1.txt');
finally
s.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
s: TStrings;
begin
s := TStringList.Create;
try
s.LoadFromFile('c:/1.txt');
Edit1.Text := self.IdDecoderMIME1.DecodeString(s.CommaText);
finally
s.Free;
end;
end;

end.
 
求的是函数!不是控件
 
上面说的就是一个base64的编码.
 
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.
 
在网上找的对加密后的字符列表存入文件后,重新载入对它解密时就还不到原了.
我想要的是这样的:
procedure EncryptStrings(var strings: tstrings;
key: string);
begin
...
strings.savetofile('./123.txt');
end;
function UncryptStrings(strings: tstrings;
key: string):TStrings;
begin
strings.loadformfile('./123.txt');
......
end;
 
这个我有很好很快速的方法,一直在用
是先将String用某种方法如DES加密后再转为十六进制的字母或转为BASE64码后
再附值给String
 
blude的转十六进制函数太慢,无实用价值。
 
也是在网上找的,试了一下可以满足你的要求.
function EnDe_Crypt(const Src: String;
Key: Word;Encrypt:Boolean):String;
var
i:Integer;
b:Byte;
mc:Char;
Map,Map0:array[0..255]of Char;
begin
for i:=0 to 255do
Map:=Char(i);
for i:=127do
wnto 2do
//根据Key生成映射表
begin
b:=Byte(Key mod (i-1))+1;
mc:=Map;
Map:=Map;
Map:=mc;
b:=Byte(Key mod (i-1))+128;
mc:=Map[i+127];
Map[i+127]:=Map;
Map:=mc;
end;
if not Encrypt then
begin
//用于解密的
Move(Map[0],Map0[0],SizeOf(Map));
for i:=0 to 255do
Map[Byte(Map0)]:=Char(i);
end;
SetLength(Result,Length(Src));
for i:=1 to Length(Src)do
Result:=Map[Byte(Src)];
end;

procedure TFrmCrypt.btnPEncrypClick(Sender: TObject);
begin
Memo2.Text:=EnDe_Crypt(Memo3.Text,7531,true);
end;

procedure TFrmCrypt.btnSaveClick(Sender: TObject);
begin
if memo2.Lines.Count>0 then
memo2.Lines.SaveToFile('./RC/GS.ini');
end;

procedure TFrmCrypt.bsSkinXFormButton1Click(Sender: TObject);
begin
memo2.Clear;
memo2.Lines.LoadFromFile('./RC/GS.ini');
end;

procedure TFrmCrypt.btnPDecrypClick(Sender: TObject);
begin
Memo2.Text:=EnDe_Crypt(Memo3.Text,7531,false);
end;
 
这个事情我是自己写一个个函数,如果保密级别不是太高,应该很容易实现呀。
 
to kmchen
贴一段代码看看,
 
接受答案了.
 
后退
顶部