飘云阁

 找回密码
 加入我们

QQ登录

只需一步,快速开始

查看: 6201|回复: 5

PYG2006注册机源码(DELPHI)

[复制链接]

该用户从未签到

发表于 2007-1-29 11:44:46 | 显示全部楼层 |阅读模式
编程园地冷清,发个贴子活跃一下气氛。: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 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.
PYG19周年生日快乐!
  • TA的每日心情
    开心
    2018-2-26 08:32
  • 签到天数: 19 天

    [LV.4]偶尔看看III

    发表于 2007-1-29 12:42:21 | 显示全部楼层
    学习,兄弟要多教教我们不会编程的弟兄们阿!
    PYG19周年生日快乐!
  • TA的每日心情
    开心
    2024-12-1 11:04
  • 签到天数: 12 天

    [LV.3]偶尔看看II

    发表于 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:
    PYG19周年生日快乐!

    该用户从未签到

    发表于 2007-4-7 17:05:10 | 显示全部楼层
    厉害呀!学习了!
    PYG19周年生日快乐!

    该用户从未签到

    发表于 2007-4-15 16:17:25 | 显示全部楼层
    DELPHI代码,看起来晕忽忽的,没有学过,看来要努力了
    PYG19周年生日快乐!
  • TA的每日心情
    奋斗
    2018-8-8 20:16
  • 签到天数: 1 天

    [LV.1]初来乍到

    发表于 2007-7-7 12:09:22 | 显示全部楼层
    不错 学习下
    PYG19周年生日快乐!
    您需要登录后才可以回帖 登录 | 加入我们

    本版积分规则

    快速回复 返回顶部 返回列表