Delphi - 软件注册的一个例子

利用主板序列号来注册的一个例子,希望对大家有帮助.

Unit RegObj;

Interface

Uses
Windows,
Messages,
SysUtils,
Classes,
Forms;

Type
TRegObj= Class
Private
FSerial: String; //主板序列号
FKey: String; //密码
FMaxTimes: Integer; //最大运行次数
FCompany: String; //公司名称
FEmail: String; //联系用的电子邮件
Protected
Procedure SetSerial; //取得主扳的序列号
Procedure GetKey; //从用户序列号文件中读取序列号
Function GetTimes: Integer; //从文件中读取程序的运行次数
Function CheckKey: Boolean; //检查序列号和密码是否匹配的函数
Public
Constructor Create;
Function Execute: Boolean; //运行对象方法
Published
Property Company: String Read FCompany Write FCompany;
Property MaxTimes: Integer Read FMaxTimes Write FMaxTimes;
Property Email: String Read FEmail Write FEmail;
End;

Implementation

//TRegObj.

Constructor TRegObj.Create;
Begin
Inherited;
End;

Function TRegObj.GetTimes: Integer;
Const
//用于存储运行次数的文件,开发人员可自定义或使用注册表存储运行次数
//起此名字用于迷惑破解者，使用前不要和系统的动态链接库同名
Tmp= 'ispnet.dll';
Var
Ch: Char;
Dir: Array[ 0..255 ] Of Char;
Fn: String;
I: Integer;
List: Tstrings;
Begin
//取得Windows系统的目录
GetSystemDirectory( @Dir, 255 );
For I := 0 To 255 Do
Begin
If Ord( Dir[ I ] )= 0 Then
Break;
Fn := Fn+ Dir[ I ];
End;
Fn := Fn+ '\'+ Tmp;
Try
List := TStringList.Create;
If Not FileExists( Fn ) Then
Ch := Chr( 1 )
Else
Begin
List.LoadFromFile( Fn );
Ch := List.Text[ 1 ];
Ch := Chr( Ord( Ch )+ 1 );
End;
List.Text := Ch;
//存储运行次数
List.SaveToFile( Fn );
Result := Ord( Ch );
Finally
List.Free;
End;
End;

Procedure TRegObj.SetSerial;
Begin
//取得主板的序列号
FSerial := String( Pchar( Ptr( $FEC71 ) ) );
End;

//取得密码

Procedure TRegObj.GetKey;
Const
Sn= 'Key.dat';
Var
List: TStrings;
Fn, Path: String;
Begin
Path := ExtractFilePath( Application.ExeName );
Fn := Path+ Sn;
If Not FileExists( Fn ) Then
Begin
FKey := '';
Exit;
End;
Try
List := TStringList.Create;
List.LoadFromFile( Fn );
FKey := List.Values[ 'Key' ];
Finally
List.Free;
End;
End;

Function TRegObj.CheckKey: Boolean;
Begin
//开发人员根据自己的需要进行修改,在这里是为了简单起见
Result := FKey= FSerial;
End;

Function TRegObj.Execute: Boolean;
Var
Msg: String;
T: Integer;
Begin
T := GetTimes;
GetKey;
SetSerial;
If FKey<> FSerial Then
Begin
Msg := ' 您这是第'+ IntToStr( T )+ '次运行此程序（最大次数：'+ IntToStr( FMaxTimes )+ '）！';
Application.MessageBox( PChar( Msg ), '用户信息', Mb_Ok+ Mb_IconWarning );
Msg := '欢迎使用'+ Company+ '的软件,如果您觉得满意的话,请注册或购买正版软件！';
Application.MessageBox( PChar( Msg ), '建议', Mb_Ok+ Mb_IconInformation );
If T> FMaxTimes Then
Begin
If Application.MessageBox( ' 是否注册？', '注册', Mb_YesNo+ Mb_IconQuestion )= Id_Yes Then
Begin
Msg := '您的注册号是：“'+ FSerial+ '”'+ Chr( 13 )+ Chr( 10 )+
'请您将以上序列号通过电子邮件寄给以下信箱:'+ FEmail;
Application.MessageBox( PChar( Msg ), '软件 注册', Mb_Ok+ Mb_Iconinformation );
End;
Application.Terminate;
End;
End;
End;

End.

控件写好了,看看控件的使用方法:

Procedure TForm1.FormCreate( Sender: TObject );
Var
AObj: TRegObj;
Begin
Try
AObj := TRegObj.Create;
AObj.MaxTimes := 30;
AObj.Company := 'Savagers';
AObj.Email := 'HuangJacky@163.com';
AObj.Execute;
Finally
AObj.Free;
End;
End;

就这么简单了.
好了,介绍完了,文章最早在大富翁上面看见,自己测试了下正常.
原作者不详了,不过我们还是要感谢他.