网站 › 『 编程之美 』 › PYG2006注册机源码（DELPHI）

caterpilla 发表于 2007-1-29 11:44:46

PYG2006注册机源码（DELPHI）

编程园地冷清，发个贴子活跃一下气氛。:lol: :lol: :lol:

unit pygcrackmeReg;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils,IdHash,IdHashMessageDigest;

type
TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Label5: TLabel;
    Edit5: TEdit;
    Label6: TLabel;
    Edit6: TEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
    key:integer;
    maccode:integer;
    internalReg:string;
    internalMD5:string;
    procedure GenerateKeyFile(filepath:string);
    procedure GetInternalRegCode;
    function engypt(str:string):string;
    function unengypt(str:string):string;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{
1、本CRACKME为FSG壳，脱壳后有自校验，去掉之；
2、FORM启动时读取硬盘序列号，其中CRACKME所在盘用于生成KEY文件内容
   而读C盘的序列号用于生成机器码；序列号存在负值的情况，要特别处理
   用C盘序列号经过变换，用MD5变换，用于生成注册码的后八位
3、另外还有根据机器码，邮箱信息进行的变换，具体见程序
}
procedure TForm1.Button1Click(Sender: TObject);
var
drive:string;
f:TextFile;
prevpos,currentpos:integer;
begin
if (edit3.Text ='') or (edit4.text='')then
begin
    showmessage('Please input name,mail andcrackme file path!');
end;
if OpenDialog1.Execute then
begin
    edit5.Text:=OpenDialog1.FileName;
end;
drive:=leftstr(edit5.Text,1);
GenerateKeyFile(drive+':\');
prevpos:=posex('\',edit5.Text,1);
currentpos:=prevpos;
while currentpos<>0 do
begin
    prevpos:=currentpos;
    currentpos:=posex('\',edit5.Text,prevpos+1);
end;
drive:=leftstr(edit5.Text,prevpos)+'PYG2006.KEY';
AssignFile(f,drive);
Rewrite(f);
Write(f,inttostr(key));
CloseFile(f);

edit1.Text:=inttostr(key);
Edit2.Text:=inttostr(maccode);

GetInternalRegCode;
end;

function TForm1.engypt(str: string): string;
var
i,j:integer;
singleletter:string;
begin
result:='';
for i := 1 to $13 do
begin
   singleletter:=midstr(str,i,1);
   SetLength(singleletter,1);
   j:=ord(singleletter)+$4 +i;
   result:=Result+chr(j);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//GenerateKeyFile('c:\');
end;

procedure TForm1.GenerateKeyFile(filepath: string);
var
serialnumber:integer;
comlen:DWORD;
flag:DWORD;
str:string;
MyMD5:TIdHashMessageDigest5;
hashvalue:T4x4LongWordRecord;
NotS:integer;
begin
GetVolumeInformation(Pchar(filepath),nil,MAX_PATH+1,@serialnumber,comlen,flag,nil,MAX_PATH+1);
str:=leftstr(inttostr(serialnumber),6);
if(serialnumber<0) then
begin
    str:=RightStr(str,3)+'1'+midstr(str,2,2);
end
else
begin
    str:=rightstr(str,3)+leftstr(str,3);
end;
key:=20041201*18+strtoint(str);
GetVolumeInformation('c:\\',nil,MAX_PATH+1,@serialnumber,comlen,flag,nil,MAX_PATH+1);
if(serialnumber<0) then
begin
    maccode:=not serialnumber;
    ShowMessage(inttostr(maccode));
    maccode:=maccode+$d22f3;
end
else
begin
    maccode:=serialnumber+$1e240;
end;
maccode:=strtoint(leftstr(inttostr(maccode),9));
NotS:=not serialnumber;
NotS:=NotS div 2;
NotS:=NotS+$75bcd15;
MyMD5:=TIdHashMessageDigest5.Create;
try
    hashvalue:=MyMD5.HashValue(inttostr(NotS));
    internalMD5:=MyMD5.AsHex(hashvalue);
finally
    MyMD5.Free;
end;
end;

procedure TForm1.GetInternalRegCode;
const
number:string='5201314896788888888888888888888888';
letter:string='chinapygabcdefghijklmopqrstuvwxyza';
var
i,j:Integer;
macstr:string;
middlestr:string;
mailstr:string;
singleletter:string;
begin
macstr:=inttostr(maccode);
middlestr:='';
for i:=1 to Length(macstr) do
begin
   j:=strtoint(midstr(macstr,i,1));
   middlestr:=middlestr+MidStr(number,j+1,1);
end;
mailstr:=edit4.Text;
j:=0;
for i := 1 to Length(mailstr) do
begin
   singleletter:=midstr(mailstr,i,1);
   SetLength(singleletter,1);
   j:=(j+ord(singleletter)) xor $3;
end;
middlestr:=inttostr(strtoint(middlestr)+key+j);
for i:=1 to Length(macstr) do
begin
   j:=strtoint(midstr(macstr,i,1));
   middlestr:=middlestr+UpperCase(MidStr(letter,j+1,1));
end;
middlestr:=LeftStr(middlestr,5)+'-'+midstr(middlestr,6,Length(middlestr)-5);
internalReg:=middlestr;
edit6.Text:=unengypt(internalReg);
end;

function TForm1.unengypt(str: string): string;
var
i,j:integer;
singleletter:string;
begin
result:='';
for i := 1 to $13 do
begin
   singleletter:=midstr(str,i,1);
   SetLength(singleletter,1);
   j:=ord(singleletter)-$4 -i;
   result:=Result+chr(j);
end;
result:=Result+midstr(internalMD5,5,8);
end;

end.

wzwgp 发表于 2007-1-29 12:42:21

学习，兄弟要多教教我们不会编程的弟兄们阿！

飘云 发表于 2007-1-30 09:14:47

原帖由 caterpilla 于 2007-1-29 11:44 发表
编程园地冷清，发个贴子活跃一下气氛。:lol: :lol: :lol:

unit pygcrackmeReg;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtr ...
/:good :lol:

acafeel 发表于 2007-4-7 17:05:10

厉害呀！学习了！

小子贼野 发表于 2007-4-15 16:17:25

DELPHI代码，看起来晕忽忽的，没有学过，看来要努力了

sharkyc 发表于 2007-7-7 12:09:22

不错 学习下

查看完整版本: PYG2006注册机源码（DELPHI）