PYG2006注册机源码（DELPHI）

来源：互联网发布：正义联盟英雄排名知乎编辑：程序博客网时间：2024/05/17 09:47
http://74.220.201.104/cmbfree/read.php?tid=15189
PYG2006注册机源码（DELPHI）
http://74.220.201.104/cmbfree/read.php?tid=15189 
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 and  crackme 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[1])+$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[1])) 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[1])-$4 -i;
    result:=Result+chr(j);
  end;
  result:=Result+midstr(internalMD5,5,8);
end;
end.