简单的加密算法 破解注册机的一些函数集

注册机其实就是一个专门用于分析修改软件内部程序信息的专用软件工具，它本身也是一种程序，一种高级程序。

注册机分为内部注册机和外部注册机二种，它们破解软件注册信息的过程不尽相同，但结果是一样的。内部注册机的版本必须与所要破解的原文件版相一致，否则不能起到破解作用。外部注册机有些是可以通用的（通用版）。  

破解软件注册信息的目的只有一个，就是想无偿使用有偿的软件文件，这是一种侵犯软件知识产权的行为，是与法律背道而驰的违法行为。

学习破解，写注册机的一些函数集 

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

result:=copy(str,length(str) p 2,int)

else

result:=copy(str,Length(str)p 2-(int-Length(str)p 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

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) p 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) p 2) do

begin

if i<>1 then midS:= tmpstr;

tmpstr:='';

for j:=1 to (length(midS) p 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) p 2) downto 1 do

begin

if i<>(length(hexskey) p 2) then midS:= tmpstr;

tmpstr:='';

for j:=1 to (length(midS) p 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) p 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) p 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) p 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;

By：黑夜彩虹