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;

就這麼簡單了.
好了,介紹完了,文章最早在大富翁上面看見,自己測試了下正常.
原作者不詳了,不過我們還是要感謝他.