老文章档案 · 2003 年

主页秀 3.2 KEYGEN-DIKEN

破解教程 · 算法分析 · 2003-09-03 · 作者：人气： · 出处：赢政天下整理收藏）

program CrDLLShow ;

uses

Windows,

Messages,

CommCtrl;

{$R software.RES}

var WinClass: TWndClassA;

Inst: HINST;

hWindow: HWND;

TheMessage: TMsg;

Image: HWND;

hImage: HBITMAP;

htitle:HWND;

editName:HWND;

editOrg: HWND;

editCode:HWND;

cmbGen: HWND;

cmbabout: HWND;

cmbExit: HWND;

PaintStruct: TPaintStruct;

PaintDC: HDC;

OldFont: HFONT;

hFont1: HFONT;

function strtoint(istr:string):integer;

var

index,len:integer;

str:string;

re:integer;

begin

str:=istr;

len:=length(str)+1;

re:=0;

index:=1;

// 'AB0'

repeat

if str[index] in ['0'..'9'] then re:=re*16+ord(str[index])-$30

else re:=re*16+ord(str[index])-$41+10;

inc(index);

until index=len;

strtoint:=re;

end;

function inttohex(ivalue:DWORD;ibits:integer):string;

var

str:string;

value:DWORD;

bits,index:integer;

begin

str:='';

value:=ivalue;

bits:=ibits;

repeat

case (value and $F) of

0..9:str:=chr(value and $F +$30)+str;

10:str:='A'+str;

11:str:='B'+str;

12:str:='C'+str;

13:str:='D'+str;

14:str:='E'+str;

15:str:='F'+str;

end;

value:=value shr 4;

until value=0;

value:=length(str);

for index:=value to bits-1 do str:='0'+str;

inttohex:=str;

end;

function check(istr:string):Boolean;

var

ok:Boolean;

str:string;

len,count:integer;

begin

OK:=False;

str:=istr;

len:=length(str)+1;

count:=1;

repeat

if not ((str[count] in ['0'..'9']) or (str[count] in ['A'..'F'])) then

OK:=True;

inc(count);

until ((count=len) or (ok));

check:=not OK;

end;

procedure Gen();

var

str:string;

StrName:string;

lenOrg,lenName:integer;

index,len,init:integer;

UID:string;

strCode:string;

code:array[1..6] of byte;

RCode:integer;

begin

//×¢²áÂëÉú³É´úÂë

//serB&nz|mfM1/5(!sd$Mq.{s]+sFjtKpzSdtzoXqmb^Al@dv:s?x/..|b!pz*ls;rn|lf$vi^Axpe)rx5aic&9/2m5lsi4@0dmZw94cmqpfhw

//(53)+2+();

str:='www.okayle.com';

UID:='';strName:='';strCode:='';

lenName:=getwindowtextlength(editName);

lenOrg:=getwindowtextlength(editOrg);

for index:=1 to lenName do strName:=strName+' ';

for index:=1 to lenOrg do UID:=UID+' ';

GetWindowTextA(editName,pchar(strName),50);

GetWindowTextA(editOrg,pchar(UID),50);

UID:=UID+'00000-00000-00000-00000-00000';

//8D8D----3

UID:=copy(UID,1,5)+copy(UID,7,5)+copy(UID,13,4);

if check(UID) then

begin

len:=length(UID);

for index:=6 downto 1 do

begin

init:=strtoint(copy(UID,len-3,2));

RCode:=strtoint(copy(UID,len-1,2));

RCode:=RCode xor ord(str[index]);

len:=len-2;

RCode:=RCode-Init;

if RCode<0 then

RCode:=RCode+$FF;

Code[index]:=RCode;

end;

strName:=strName+' ';

len:=length(strName);

if len>9 then

begin

//370531

strName:=copy(strName,1,8)+'8760';

{ code[1]:=$33; code[2]:=$37; code[3]:=$30;

code[4]:=$35; code[5]:=$33; code[6]:=$31;}

RCode:=random($100);

strCode:=inttohex(RCode,2);

for index:=1 to 6 do

begin

RCode:=(RCode+Code[index]);

if RCode>$FF then RCode:=RCode-$FF;

RCode:=RCode xor Ord(strName[index]);

strCode:=strCode+inttohex(RCode,2);

end;

for index:=1 to 6 do

strCode:=strCode+char(random(10)+$30);//+'19791126';

end;

end

else

strCode:='Error Pre-Serial';

setWindowTextA(editCode,pchar(strCode));

end;

{ Custom WindowProc function }

function WindowProc(hWindow: HWnd; Message,wParam,lParam: Integer): Integer; stdcall;

begin

Result := 0;

{ Checks for messages }

case Message of

WM_CREATE: begin

hImage := LoadBitmap(Inst,PChar('software'));

end;

WM_COMMAND: begin

if HWND(lParam) = cmbGen then Gen();

if HWND(lParam) = cmbAbout then MessageBox(hWindow,'========CoDE bY DikEN========'

+#13

+'Contact me--->'

+#13

+' mail:thehellgate@263.net'

+#13

+' site:xsoftz.yeah.net'

+#13

+' QQ:99674724'

+#13

+' ^_^'+#13#13

+'==================DiKeN=====',

'About',MB_OK);

if HWND(lParam) = cmbExit then SendMessage(hWindow,WM_DESTROY,0,0);

end;

WM_PAINT:begin

{ Paint Colors text: Label1 }

PaintDC := BeginPaint(hWindow,PaintStruct);

//Draw a line

MovetoEx(PaintDC,20,55,nil);

LineTo(PaintDC,400,55);

MovetoEx(PaintDC,10,210,nil);

LineTo(PaintDC,400,210);

MovetoEx(PaintDC,10,212,nil);

LineTo(PaintDC,400,212);

hFont1 := CreateFont(-11,0,0,0,FW_BOLD,0,1,0,DEFAULT_CHARSET,0,0,0,0,'MS Sans Serif');

OldFont := SelectObject(PaintDC,hFont1);

SetBkColor(PaintDC,GetSysColor(COLOR_BTNFACE));

SetTextColor(PaintDC,RGB($33,$99,$33));

TextOut(PaintDC,125,220,Pchar('CoDe bY DiKeN With Delphi'),25);

SetTextColor(PaintDC,RGB($00,$00,$CC));

TextOut(PaintDC,110,235,Pchar('xsoftz.yeah.net'),15);

TextOut(PaintDC,210,235,Pchar('xcrypt.yeah.net'),15);

SelectObject(PaintDC,OldFont);

end;

WM_DESTROY: begin

DeleteObject(hFont1);

PostQuitMessage(0);

Exit;

end;

else

Result := DefWindowProc(hWindow, Message, wParam, lParam);

end;

begin

{ Register Custom WndClass }

Inst := hInstance;

with WinClass do

begin

style := CS_CLASSDC or CS_PARENTDC;

lpfnWndProc := @WindowProc;

hInstance := Inst;

hbrBackground := color_btnface + 1;

lpszClassname := 'MyWindowClass';

hIcon := LoadIcon(Inst, 'MAINICON');//IDI_APPLICATION);

hCursor := LoadCursor(0, IDC_ARROW);

end; { with }

RegisterClass(WinClass);

// Create Main Window =========

hWindow := CreateWindowEx(WS_EX_WINDOWEDGE,

'MyWindowClass',

'ºôÎü[okÁË!]ÏµÁÐ Ö÷Ò³Ðã 3.2 KeyGen-DiKeN',

WS_VISIBLE or WS_MINIMIZEBOX or WS_SYSMENU,

193,140,415,280,0, 0, Inst, nil);

// Create a static image ===========================================

Image:= CreateWindow('Static','', WS_VISIBLE or WS_CHILD or SS_BITMAP,

20,15,32,32, hWindow, 0, Inst, nil);

SendMessage(Image,STM_SETIMAGE,IMAGE_BITMAP,LParam(hImage));

// Create a label (static) =========================================

//Create the title

htitle:=Createwindow('Static',

'ºôÎü[okÁË!]ÏµÁÐ Ö÷Ò³Ðã 3.2',

WS_VISIBLE or WS_CHILD or SS_LEFT,

60,24,360,15, hWindow, 0, Inst, nil);

hFont1 := CreateFont(-11,0,0,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,0,0,0,0,'MS Sans Serif');