总结一些加密算法

有一些是之前学破解写注册机时写的，一些是我改写某些兄弟的代码来的，写的不好多多指教：

{=======================================================
学习破解，写注册机的一些函数集
by：黑夜彩虹
========================================================}
function wzwgp(s: string): string; //取累加值
var i,sum:integer;
begin
sum:=0; for i:=1 to length(s) do
begin
sum:=sum ord(s[i]);
end;
result :=inttostr(sum);
end;

function ascii10add(s: string): string; //取累加值
var i,sum:integer;
begin
sum:=0; for i:=1 to length(s) do
begin
sum:=sum ord(s[i]);
end;
result :=inttostr(sum);
end;

function ascii16add(s: string): string; //取累加值
var i,sum:integer;
begin
sum:=0; for i:=1 to length(s) do
begin
sum:=sum ord(s[i]);
end;
result :=inttohex(sum,2);
end;

function float( a:integer ):string;
var i:integer;
s:extended;
begin
s:=0;
i:=1;
for i:=1 to a do
begin
s:=s 1/i;
end;
result:=floattostr(s);
end;

function float2( a:integer ):string; //浮点数学运算
var i:integer;
s:extended;
begin
s:=0;
i:=1;
for i:=1 to a do
begin
if i mod 2 <>0 then
s:=s 1/i
else
s:=s - 1/i;
end;
result:=floattostr(s);
end;

procedure tform1.button2click(sender: tobject);
begin

edit2.text:=float2(100);
end;
{ }

function strtoback(s: string): string; //将字符串倒转过来
var i:integer;
begin
for i:=1 to length(s) do
begin
result :=s[i] result;
end;
end;

{ }

function mdistr(str:string;int:integer):string; //取字符串的中间部份
begin
if int<length(str)div 2 then
result:=copy(str,length(str) div 2,int)
else
result:=copy(str,length(str)div 2-(int-length(str)div 2),int);
end;

{ }

function strtoascii16(s: string): string; //字符串转换ascii码16进制
var i:integer;
begin
for i:=1 to length(s) do
begin
result := result inttohex(ord(s[i]),2);
end;
end;

{ }

function strtoascii10(s: string): string; //字符串转换ascii码10进制
var i:integer;
begin
for i:=1 to length(s) do
begin
result:= result inttostr(ord(s[i]));
end;
end;

{ }

function strtoascii16(s: string): string; //字符串转换ascii码16进制，
var i:integer; // 如：黑夜彩虹＝$ba,$da,$d2,$b9,$b2,$ca,$ba,$e7
begin
for i:=1 to length(s) do
begin
result := result '$' inttohex(ord(s[i]),2) ',';
end;
result:=copy(result,0,length(result)-1);
end;

{ }
function doublestr(str: string): string; //取字符串偶位数字符
var
i: integer;
begin
result := '';
for i := 2 to length(str) do
if i mod 2 = 0 then
result := result str[i];
end;

{ }

function widestr(str:string):string; //取出字符串中的汉字
var i: integer;
begin
for i := 1 to length(widestring(str)) do
if length(string(widestring(str)[i])) = 2 then
result:= result widestring(str)[i];
end;

{ }

function strsubcount(const source,sub:string):integer; //判断某字符在字符串中的个数
var buf:string;
len,i:integer;
begin
result:=0;
buf:=source;
i:=pos(sub, buf);
len:=length(sub);
while i <> 0 do
begin
inc(result);
delete(buf,1,i len-1);
i:=pos(sub,buf);
end;
end;

{ }

function bytetohex(src: byte): string;
begin
setlength(result, 2);
asm
mov edi, [result]
mov edi, [edi]
mov al, src
mov ah, al // save to ah
shr al, 4 // output high 4 bits
add al, '0'
cmp al, '9'
jbe @@outcharlo
add al, 'a'-'9'-1
@@outcharlo:
and ah, $f
add ah, '0'
cmp ah, '9'
jbe @@outchar
add ah, 'a'-'9'-1
@@outchar:
stosw
end;
end;

{ }

function shiftstr(str1,str2:string):string; //移位字符串
var i:integer;
begin
result:='';
for i:=1 to length(str1) do
begin
result:=result str1[i] str2[i];
end;
end;

function siftstr(str: string): string; //过滤字符串
var i,j:integer;
begin
result:='';
j:=length(str);
for i:=0 to j do
begin
if str[i] in ['0'..'9','a'..'f','a'..'f'] then
result:=result str[i];
end;
end;

function isnum(str:string;int,int2:integer): string;
var i:integer;
begin
for i:=1 to length(str) do
begin
result := inttostr((strtoint('$' str[i]) or int) mod int2) result;
end;
end;

{ }
function opeatestr(const s :string): string; //字符逐位　xor 运算
const
snlen = 5 ;
sn:array[1..snlen] of integer =($0d, $01, $14, $05,$02);
var
i,n: integer;
begin
setlength(result,length(s));
for i :=1 to length(s) do begin
n := i mod snlen ;
if n = 0 then
n := 5 ;
result[i] := char(ord(s[i]) xor sn[n]);
end;
end;

{ }

function strtoencrypt(str,id,pass:string): string; //销售王进销存_keygen算法
var
username: string;
a, b, c_str, c_hex, d, e, f: string;
i, a_len: integer;
begin
username:=str;
a:=id str;
//b:= 'mraketsoft62095231';
b:=pass;
a_len := length(a);
c_str := '';
c_hex := '';
for i := 1 to a_len do
begin
c_hex := c_hex inttohex(byte(a[i]) xor byte(b[i mod length(b)]), 2) ' ';
c_str := c_str chr(byte(a[i]) xor byte(b[i mod length(b)]));
end;
d := '';
for i := 1 to length(c_str) do
begin
if byte(c_str[i]) in [$01..$09,$0a..$0f] then
d := d quotedstr('#$' inttohex(byte(c_str[i]), 1))
else d := d c_str[i];
end;
d := '''' d '''';
e := '';
for i := 1 to length(d) do
begin
if d[i] in ['0'..'9','a'..'z','a'..'z'] then e := e d[i];
end;
f := '';
for i := 1 to length(e) do
begin
f := f e[i];
if (i mod 4 = 0)and(i<length(e)){避免注册码正好是4的倍数时,最后一组加横线} then
f := f '-';
end;
result:=f;
end;
{ }
function mystrtohex(s: string): string; //原字符串转16进制字符串
var tmpstr:string;
i:integer;
begin
tmpstr := '';
for i:=1 to length(s) do
begin
tmpstr := tmpstr inttohex(ord(s[i]),2);
end;
result := tmpstr;
end;

function myhextostr(s: string): string; //16进制字符串转原字符串
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 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 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) downto 1 do
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;


//调用
edit2.text :=encryptstr(edit1.text,editkey.text);


{ }
// xor 加密/解密
function xorencdec(astr:string;key:byte):string;
var
i,n:integer;
begin
n:=length(astr);
setlength(result,n);
for i:=1 to n do
result[i]:=char(byte(astr[i]) xor key);
end;
//加法加密
function addenc(astr:string;key:byte):string;
var
i,n:integer;
begin
n:=length(astr);
setlength(result,n);
for i:=1 to n do
result[i]:=char(byte(astr[i]) key);
end;
//加法解密
function adddec(astr:string;key:byte):string;
var
i,n:integer;
begin
n:=length(astr);
setlength(result,n);
for i:=1 to n do
result[i]:=char(byte(astr[i])-key);
end;

其中xorencdec的加密/解密均为同一个过程，而加法加密、解密则需要两个过程配套使用。


procedure tform1.button1click(sender: tobject);
begin
edit2.text:=xorencdec(edit1.text,123); //加密（edit1中存放明文，edit2存放密文）
end;
procedure tform1.button2click(sender: tobject);
begin
edit1.text:=xorencdec(edit2.text,123); //解密（edit2存放密文，edit1中存放解密的明文）
end;

//====================================================
//题目：有1、2、3、4个数字，能组成多少个互不相同且无重复数字的三位数？都是多少？
function permutation( int:integer ):string;
var
i,j,k:integer;
begin
for i:=1 to int do
for j:=1 to int do
for k:=1 to int do
begin
if (i<>j) and (i<>k) and (j<>k)then
result:=result inttostr(i) inttostr(j) inttostr(k) #13 #10;
end;
end;

procedure tform1.button1click(sender: tobject);
begin
memo1.clear;
memo1.lines.add(permutation(4));
label1.caption:=inttostr(memo1.lines.count);
end;

//=============================收集函数
function acafeel(name:string):string;
var
stra,strb, strc : string;
sum, pos : integer;
begin
if name ='' then exit;
for pos := 1 to length(name) do
if (ord(name[pos]) < $20) or (ord(name[pos]) > $7e) then
begin
showmessage('请输入字母或者数字，不支持中文！');
exit;
end;
sum := ord(name[1]) * length(name) * $64;
stra := ' ' inttostr(sum) 'noname swordman noname';
strb := stra[$12] (stra[$7] stra[$8]) stra[$9] stra[$5] stra[$3]
stra[$1] (stra[$14] stra[$15] stra[$16] stra[$17] stra[$18])
(stra[$d] stra[$e]) stra[$8];
for pos := 1 to length(strb) do
if (ord(strb[pos]) <> $20) then strc := strc strb[pos];
if length(strc) < 14 then
begin
strc := strc copy(stra, 7, 23);
strc := copy(strc, 1, 15) 'bywjy';
end;
result := copy(strc, 1, 5) '-' copy(strc, 5, 4) '-' copy(strc, 8, 4)
'-' copy(strc, 11, 4) '-' copy(strc, 14, 7);
end;

function acafeel2(name:string):string;
var
temp1, temp2, temp3,
tempa, tempb, tempc1, tempc2, tempd1, tempd2,
pos, posstr, posadd, possub : integer;
begin
if length(name) < 5 then //如果：注册名长度小于5位数
begin
showmessage('注册名的长度必须大于4位数!');
exit;
end;

//如果：注册名长度大于等于5位数，小于等于9位数
if (5 <= length(name)) and (length(name) <= 9) then
begin
{大循环1}//////////////////////////////////////////////////{大循环1}
// name := editname.text;
//第一次
temp1 := ((ord(name[1]) $56b) xor $890428) $18;
temp2 := ((ord(name[4]) length(name)) xor $54) xor $25d;
temp3 := (ord(name[1]) $56b) * $1024;
tempa := ((temp1 * temp2) $400) temp3 ;
//第二次开始循环
for pos := 2 to length(name) do
begin//取字符的ascii码
temp1 := temp1 ((ord(name[pos]) $56b) xor $890428);
temp2 := ((ord(name[4]) length(name)) xor $54) xor $25d;
temp3 := (ord(name[pos]) $56b) * $1024;
tempa := tempa (temp1 * temp2) temp3;
end;
end;

if length(name) > 9 then //如果：注册名长度大于9位数
begin
{大循环1}//////////////////////////////////////////////////{大循环1}
// name := editname.text;
//第一次
temp1 := ((ord(name[1]) $56b) xor $890428) $18;
temp2 := (((ord(name[4]) length(name)) xor $54) xor $25d) * $400;
temp3 := ((ord(name[1]) $56b) * $1024) $400;
tempa := temp3;
//第二次开始循环
for pos := 2 to length(name) do
begin//取字符的ascii码
temp1 := temp1 temp2 ((ord(name[pos]) $56b) xor $890428);
temp2 := (((ord(name[4]) length(name)) xor $54) xor $25d) * temp3;
temp3 := temp3 ((ord(name[pos]) $56b) * $1024);
tempa := temp3;
end;
temp1 := temp1 temp2;
end;

{小循环1}//////////////////////////////////////////////////{小循环1}
// name := editname.text;
//第一次
tempb := ord(name[5 1]) $32 $134a;////
{字符串反顺序}//比如开始：acafeel
for posstr := length(name) downto 1 do
begin
name := name name[posstr];
end;
posstr := length(name) div 2;
name := copy(name, posstr 1, posstr);
{字符串反顺序}//比如结束：leefaca
//第二次开始循环
for pos := 4 downto 1 do
begin
tempb := tempb ord(name[pos 1]) $134a;////
{字符串反顺序}
for posstr := length(name) downto 1 do
begin
name := name name[posstr];
end;
posstr := length(name) div 2;
name := copy(name, posstr 1, posstr);
{字符串反顺序}
end;

{小循环2}//////////////////////////////////////////////////{小循环2}
//第一次
tempc1 := ord(name[1]) tempb $134a;
tempc2 := ((ord(name[2]) $23) * $25a) temp1;
//第二次开始循环
posadd := 2;
for pos := 4 downto 1 do
begin
posadd := posadd 1;
tempc1 := tempc1 ord(name[1]) $134a;
tempc2 := tempc2 ((ord(name[posadd]) $23) * $25a);
if (posadd = 4) or (posadd = 5) then
begin
{字符串反顺序}
for posstr := length(name) downto 1 do
begin
name := name name[posstr];
end;
posstr := length(name) div 2;
name := copy(name, posstr 1, posstr);
{字符串反顺序}
end;
end;

{最后检测}//////////////////////////////////////////////////{最后检测}
// name := editname.text;
tempd1 := (tempc2 $3c) xor ($1337 - ord(name[3]));
tempd2 := (tempc1 tempa) xor ($18 - ord(name[6]));
result:= 'rhm' '-' inttostr(tempd1) inttostr(tempd2);
end;


//======================johnroot写的注册机改写(不懂算法的cm)
function johnroot(name:string):string;
var
nameok,gg,gg2,mm,mm2:pchar;
i,j,j2,k:integer;
begin
getmem(nameok,$10);
zeromemory(nameok,$10);
getmem(mm,5);
zeromemory(mm,5);
getmem(mm2,5);
zeromemory(mm2,5);

for i:=0 to (length(name)-1) do
begin
nameok[i]:=name[i];
end;

j:=0;
for i:=0 to $f do
begin
k:=ord(nameok[i]) xor $82;
j:=j k;
end;
gg := pchar(inttostr(j));

j:=0;
for i:=0 to $f do
begin
k:=ord(nameok[i]) xor $28;
j2:=j2 k;
end;
gg2 := pchar(inttostr(j2));
if length(gg2)<4 then
begin
gg2:=pchar('0' string(gg2));
end;

for i:=0 to 3 do
begin
mm[i]:= char($69 - ord(gg[i]));
end;

for i:=0 to 3 do
begin
mm2[i]:= char($69 - ord(gg2[i]));
end;
result:=string(gg) string(gg2) string(mm) string(mm2);
end;