KeyGenMe V1.01 by Mushu

xingke

来源：http://musoft.blog.sohu.com/39167153.html

无聊写着玩的，就是感觉水纹效果和vista风格的按钮很PL，其他的，无技术含量，故意留版本号1.01，方便升级，哈哈~[简单的mushu在笑]

源码如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, RibbonBase, ExtFadeControl,
  RibbonButton, untWaterEffect, WinSkinData,MD5,GetDSN;
////////////////////////////////////////////////////
//   Musoft的处女作，熟悉DELPHI~~QQ群：30881567   //
//        http://musoft.blog.sohu.com             //
////////////////////////////////////////////////////
type
  TForm1 = class(TForm)
    img1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    RibbonButton1: TRibbonButton;
    RibbonButton2: TRibbonButton;
    Label3: TLabel;
    tmr1: TTimer;
    SkinData1: TSkinData;
    procedure FormCreate(Sender: TObject);
    procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure tmr1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RibbonButton2Click(Sender: TObject);
    procedure RibbonButton1Click(Sender: TObject);
  private
    { Private declarations }
    Water: TWaterEffect;
    Bmp: TBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x:integer;

implementation

{$R *.dfm}
////////////////////////////////////////////////
//一些无用的ANTI，网络上早已泛滥，充场面，哈哈//
////////////////////////////////////////////////
Procedure Anti_DeDe();//检测DEDE反编译器
var
  DeDeHandle:THandle;
  i:integer;
begin
  DeDeHandle:=FindWindow(nil,chr($64)+chr($65)+chr($64)+chr($65));
  if DeDeHandle<>0 then
    begin
      For i:=1 to 4500 do
        SendMessage(DeDeHandle,WM_CLOSE,0,0);
    end;
end;

Function ABC42():Boolean; //检测调试器;
var
  YInt,NInt:Integer;
begin
  asm
    mov eax,fs:[30h]
    movzx eax,byte ptr[eax+2h]
    or al,al
    jz @No
    jnz @Yes
    @No:
      mov NInt,1
    @Yes:
      Mov YInt,1
  end;
  if YInt=1 then
    Result:=True;
  if NInt=1 then
    Result:=False;
end;

//Anti-Monitor   
Function   ABC39:   Boolean;   //检测Dump;
var
  hFile: Thandle;
Begin
Result:= false;
  hFile := FindWindow(nil,'ProcDump32   (C)   1998,   1999,   2000   G-RoM,   Lorian   &   Stone');
if(   hFile   <>   0   )   then
begin
  Result:=   TRUE;
end;
End;
   
Function   ABC40:   Boolean;   //检测RegMON;
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile:= FindWindow(nil,'Registry   Monitor   -   Sysinternals:   www.sysinternals.com');
  if(   hFile   <>   0   )   then
begin
  Result:=TRUE;
end;
End;
   
Function   ABC41:   Boolean;stdcall;     //检测FileMON;
var
  hFile:Thandle;
Begin
  Result:=false;
  hFile:=FindWindow(nil,'File   Monitor   -   Sysinternals:   www.sysinternals.com');
  if( hFile <> 0 ) then
begin
  Result:=TRUE;
end;
End;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Bmp := TBitmap.Create;
  Bmp.Assign(img1.Picture.Graphic);
  img1.Picture.Graphic := nil;
  img1.Picture.Bitmap.Height := Bmp.Height;
  img1.Picture.Bitmap.Width := Bmp.Width;
  Water := TWaterEffect.Create;
  Water.SetSize(Bmp.Width,Bmp.Height);

  x:=img1.Height;
end;

procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Water.Blob(x,y,1,100);
end;


procedure TForm1.tmr1Timer(Sender: TObject);
begin
  if Random(8)= 1 then
    Water.Blob(-1,-1,Random(1)+1,Random(500)+50);
  Water.Render(Bmp,img1.Picture.Bitmap);


  with img1.Canvas do
    begin
      Brush.Style:=bsClear;
      font.size:=12;
      font.color:=$FFFFFF;
      TextOut((Bmp.Width - TextWidth('Musoft'))div 2+2,
        10,'Musoft');
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
  Water.Free;
end;


procedure TForm1.RibbonButton2Click(Sender: TObject);
begin
close
end;
//////////////////////////////////////////////
//很蹩脚又很简单的算法，开始忽悠ING，嘿嘿 。//
//////////////////////////////////////////////
function Musoft(X,Y:string):string;
begin
  Result:=IntToHex((StrToInt('$'+X) xor StrToInt('$'+Y)),1);
end;
procedure TForm1.RibbonButton1Click(Sender: TObject);
var
  i:integer;
  S1,S2,S3,S4,A,B,C,D,E,F,G:string;
  InputStr:array [1..2] of string;
  OutputStr,XORStr:string;
  strTmp:string;
begin
S3:= Trim(GetIdeDiskSerialNumber()); //取得硬盘ID，并去掉空格，将16进制连成字符串
  S4:=StringReplace ( S3, ' ', '', [rfReplaceAll] );
  S1:=S4;
  S2:='';
  for i:=1 to length(S1) do
  begin
    S2:=S2+IntToHex(Ord( S1[ i ] ),2);
  end;
  if length(edit1.Text)>=6  then //用户名不小于6位
  Begin
  for i:=1 to length(Edit1.Text) do
  C:=C+IntToHex(Ord(Edit1.Text[ i ]),2);     //用户名转换成16进制并连接
  B:=copy(c,1,2);           //取用户名前两位16进制
  InputStr[1]:='';
  InputStr[2]:='';
  OutputStr:='';
  XORStr:=B;
  for i:=1 to length(S2) div 2 do       //异或运算
  begin
    InputStr[1]:=copy(S2,2*i-1,1);
    InputStr[2]:=copy(S2,2*i,1);
    InputStr[1]:=Musoft(InputStr[1],XORStr[1]);
    InputStr[2]:=Musoft(InputStr[2],XORStr[2]);
    OutputStr:=OutputStr+InputStr[1]+InputStr[2];
  end;
    D:=''+ UpperCase(MD5Print(MD5String(OutputStr)));   //上面的结果进行MD5
    E:=copy(D,5,1)       //取第5位
  end;
  begin
  if length(edit2.Text)>=6 then
  for i:=1 to length(Edit2.Text) do          //注册码16进制连接
  F:=F+IntToHex(Ord(Edit2.Text[ i ] ),2);
  G:=copy(F,4,1)          //取第4位
  end;
  begin
  if (length(e)<>0) and (E=G)  then             //比较
  Edit2.Text:='RegisteD By:'+edit1.Text
end;
end;
end.

Nisy

贴张图大家看下  水纹还看不到 ~~