有一些是之前學(xué)破解寫注冊機時寫的，一些是我改寫某些兄弟的代碼來的，寫的不好多多指教：

{=======================================================
學(xué)習(xí)破解，寫注冊機的一些函數(shù)集
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:=s1/i;
end;
result:=FloatToStr(s);
end;

function float2( a:integer ):string; //浮點數(shù)學(xué)運算
var i:integer;
s:Extended;
begin
s:=0;
i:=1;
for i:=1 to a do
begin
if i mod 2 <>0 then
s:=s1/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; //將字符串倒轉(zhuǎn)過來
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;//字符串轉(zhuǎn)換ascii碼16進制
var i:integer;
begin
for i:=1 to length(s) do
begin
result := resultIntToHex(ord(s[i]),2);
end;
end;

{ }

function StrToASCII10(s: string): string; //字符串轉(zhuǎn)換ascii碼10進制
var i:integer;
begin
for i:=1 to length(s) do
begin
result:= resultinttostr(ord(s[i]));
end;
end;

{ }

function StrToASCII16(s: string): string;//字符串轉(zhuǎn)換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; //取字符串偶位數(shù)字符
var
i: Integer;
begin
Result := '';
for i := 2 to Length(Str) do
if i mod 2 = 0 then
Result := ResultStr[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:= resultWideString(Str)[I];
end;

{ }

function StrSubCount(const Source,Sub:string):integer; //判斷某字符在字符串中的個數(shù)
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
MOVEDI, [Result]
MOVEDI, [EDI]
MOVAL, Src
MOVAH, AL // Save to AH
SHRAL, 4 // Output High 4 Bits
ADDAL, '0'
CMPAL, '9'
JBE@@OutCharLo
ADDAL, 'A'-'9'-1
@@OutCharLo:
ANDAH, $f
ADDAH, '0'
CMPAH, '9'
JBE@@OutChar
ADDAH, '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_hexIntToHex(Byte(a[I]) xor Byte(b[I mod Length(b)]), 2)' ';
c_str := c_strChr(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 := dQuotedStr('#$'IntToHex(Byte(c_str[I]), 1))
else d := dc_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 := ed[I];
end;
f := '';
for I := 1 to Length(e) do
begin
f := fe[I];
if (I mod 4 = 0)and(I<Length(e)){避免注冊碼正好是4的倍數(shù)時,最后一組加橫線} then
f := f'-';
end;
Result:=f;
end;
{ }
function myStrtoHex(s: string): string; //原字符串轉(zhuǎn)16進制字符串
var tmpstr:string;
i:integer;
begin
tmpstr := '';
for i:=1 to length(s) do
begin
tmpstr := tmpstrinttoHex(ord(s[i]),2);
end;
result := tmpstr;
end;

function myHextoStr(S: string): string; //16進制字符串轉(zhuǎn)原字符串
var hexS,tmpstr:string;
i:integer;
a:byte;
begin
hexS :=s;//應(yīng)該是該字符串
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;//應(yīng)該是該字符串
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;


//調(diào)用
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個數(shù)字，能組成多少個互不相同且無重復(fù)數(shù)字的三位數(shù)？都是多少？
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;

//=============================收集函數(shù)
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('請輸入字母或者數(shù)字，不支持中文！');
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 := strCstrB[pos];
if length(strC) < 14 then
begin
strC := strCcopy(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位數(shù)
begin
showmessage('注冊名的長度必須大于4位數(shù)!');
exit;
end;

//如果：注冊名長度大于等于5位數(shù)，小于等于9位數(shù)
if (5 <= length(Name)) and (length(Name) <= 9) then
begin
{大循環(huán)1}//////////////////////////////////////////////////{大循環(huán)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 ;
//第二次開始循環(huán)
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位數(shù)
begin
{大循環(huán)1}//////////////////////////////////////////////////{大循環(huán)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;
//第二次開始循環(huán)
for pos := 2 to length(Name) do
begin//取字符的ASCII碼
temp1 := temp1temp2((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 := temp1temp2;
end;

{小循環(huán)1}//////////////////////////////////////////////////{小循環(huán)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);
{字符串反順序}//比如結(jié)束：LeeFaCa
//第二次開始循環(huán)
for pos := 4 downto 1 do
begin
tempB := tempBord(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;

{小循環(huán)2}//////////////////////////////////////////////////{小循環(huán)2}
//第一次
tempC1 := ord(Name[1])tempB$134A;
tempC2 := ((ord(Name[2])$23) * $25A)temp1;
//第二次開始循環(huán)
posADD := 2;
for pos := 4 downto 1 do
begin
posADD := posADD1;
tempC1 := tempC1ord(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 := (tempC1tempA) 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:=jk;
end;
gg := pchar(inttostr(j));

j:=0;
for i:=0 to $f do
begin
k:=ord(nameok[i]) xor $28;
j2:=j2k;
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;

版權(quán)聲明：本站文章來源標(biāo)注為YINGSOO的內(nèi)容版權(quán)均為本站所有，歡迎引用、轉(zhuǎn)載，請保持原文完整并注明來源及原文鏈接。禁止復(fù)制或仿造本網(wǎng)站，禁止在非www.sddonglingsh.com所屬的服務(wù)器上建立鏡像，否則將依法追究法律責(zé)任。本站部分內(nèi)容來源于網(wǎng)友推薦、互聯(lián)網(wǎng)收集整理而來，僅供學(xué)習(xí)參考，不代表本站立場，如有內(nèi)容涉嫌侵權(quán)，請聯(lián)系alex-e#qq.com處理。