Delphi - 软件注册的一个例子

2019独角兽企业重金招聘Python工程师标准>>>

利用主板序列号来注册的一个例子,希望对大家有帮助.
 
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;

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

转载于:https://my.oschina.net/cookblack/blog/621386