总结一些加密算法

阳光刺痛双眼却未散去悲伤 發表於 2008-10-8 19:03:57

有一些是之前学破解写注册机时写的，一些是我改写某些兄弟的代码来的，写的不好多多指教：
 
 {=======================================================
 学习破解，写注册机的一些函数集
 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))) = 2 then
 result:= result WideString(Str);
 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,
 MOV 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 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);
 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) xor Byte(b), 2) ' ';
 c_str := c_str Chr(Byte(a) xor Byte(b));
 end;
 d := '';
 for I := 1 to Length(c_str) do
 begin
 if Byte(c_str) in [$01..$09,$0A..$0F] then
 d := d QuotedStr('#$' IntToHex(Byte(c_str), 1))
 else d := d c_str;
 end;
 d := '''' d '''';
 e := '';
 for I := 1 to Length(d) do
 begin
 if d in ['0'..'9','a'..'z','A'..'Z'] then e := e d;
 end;
 f := '';
 for I := 1 to Length(e) do
 begin
 f := f e;
 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 hexS);
 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 midS);
 b:=strtoint('$' hexskey hexskey);
 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 midS);
 b:=strtoint('$' hexskey hexskey);
 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) < $20) or (ord(Name) > $7E) then
 begin
 showmessage('请输入字母或者数字，不支持中文！');
 exit;
 end;
 sum := ord(Name) * 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) <> $20) then strC := strC strB;
 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) $56B) xor $890428) $18;
 temp2 := ((ord(Name) length(Name)) xor $54) xor $25D;
 temp3 := (ord(Name) $56B) * $1024;
 tempA := ((temp1 * temp2) $400) temp3 ;
 //第二次开始循环
 for pos := 2 to length(Name) do
 begin//取字符的ASCII码
 temp1 := temp1 ((ord(Name) $56B) xor $890428);
 temp2 := ((ord(Name) length(Name)) xor $54) xor $25D;
 temp3 := (ord(Name) $56B) * $1024;
 tempA := tempA (temp1 * temp2) temp3;
 end;
 end;
 
 if length(Name) > 9 then //如果：注册名长度大于9位数
 begin
 {大循环1}//////////////////////////////////////////////////{大循环1}
 // Name := EditName.Text;
 //第一次
 temp1 := ((ord(Name) $56B) xor $890428) $18;
 temp2 := (((ord(Name) length(Name)) xor $54) xor $25D) * $400;
 temp3 := ((ord(Name) $56B) * $1024) $400;
 tempA := temp3;
 //第二次开始循环
 for pos := 2 to length(Name) do
 begin//取字符的ASCII码
 temp1 := temp1 temp2 ((ord(Name) $56B) xor $890428);
 temp2 := (((ord(Name) length(Name)) xor $54) xor $25D) * temp3;
 temp3 := temp3 ((ord(Name) $56B) * $1024);
 tempA := temp3;
 end;
 temp1 := temp1 temp2;
 end;
 
 {小循环1}//////////////////////////////////////////////////{小循环1}
 // Name := EditName.Text;
 //第一次
 tempB := ord(Name) $32 $134A;////
 {字符串反顺序}//比如开始：aCaFeeL
 for posSTR := length(Name) downto 1 do
 begin
 Name := Name Name;
 end;
 posSTR := length(Name) div 2;
 Name := copy(Name, posSTR 1, posSTR);
 {字符串反顺序}//比如结束：LeeFaCa
 //第二次开始循环
 for pos := 4 downto 1 do
 begin
 tempB := tempB ord(Name) $134A;////
 {字符串反顺序}
 for posSTR := length(Name) downto 1 do
 begin
 Name := Name Name;
 end;
 posSTR := length(Name) div 2;
 Name := copy(Name, posSTR 1, posSTR);
 {字符串反顺序}
 end;
 
 {小循环2}//////////////////////////////////////////////////{小循环2}
 //第一次
 tempC1 := ord(Name) tempB $134A;
 tempC2 := ((ord(Name) $23) * $25A) temp1;
 //第二次开始循环
 posADD := 2;
 for pos := 4 downto 1 do
 begin
 posADD := posADD 1;
 tempC1 := tempC1 ord(Name) $134A;
 tempC2 := tempC2 ((ord(Name) $23) * $25A);
 if (posADD = 4) or (posADD = 5) then
 begin
 {字符串反顺序}
 for posSTR := length(Name) downto 1 do
 begin
 Name := Name Name;
 end;
 posSTR := length(Name) div 2;
 Name := copy(Name, posSTR 1, posSTR);
 {字符串反顺序}
 end;
 end;
 
 {最后检测}//////////////////////////////////////////////////{最后检测}
 // Name := EditName.Text;
 tempD1 := (tempC2 $3C) xor ($1337 - ord(Name));
 tempD2 := (tempC1 tempA) xor ($18 - ord(Name));
 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;

頁: [1]

琼殿技术论坛's Archiver

总结一些加密算法