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

{=======================================================
               学习破解，写注册机的一些函数集
                         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);
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);
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);
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 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),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));
    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),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;
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 str2;
    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 in ['0'..'9','a'..'f','A'..'F'] then
    Result:=Result str;
    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) 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 := char(ord(s) 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),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:=Char(Byte(AStr) 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:=Char(Byte(AStr) 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:=Char(Byte(AStr)-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:=Name;
end;

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

j:=0;
for i:=0 to $f do
begin
   k:=ord(nameok) 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:= char($69 - ord(gg));
end;

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

来源：https://www.jb51.net/hack/5140.html
免责声明：如果侵犯了您的权益，请联系站长，我们会及时删除侵权内容，谢谢合作！