unit RegObj;

interface

uses
Windows,Messages,SysUtils,Classes,Forms;

type
  TRegObj=class
private
  FSerial:string;  //序列號
  FKey:string;     //注冊key
  FMaxTimes:Integer;  //最大使用次數(shù)
  FCompany:string;  //公司名稱
  FEmail:string;   //email

protected
  procedure SetSerial;  //設置序列號

  procedure GetKey;  //得到注冊key
  function GetTimes:Integer;  //得到使用次數(shù)
  function CheckKey:Boolean;  //檢查序列號和key是否相同
public
  constructor Create;  //分配對象
  function Execute:Boolean;   //執(zhí)行
published        //write file
  property Company:string read FCompany write FCompany;    //公司名
  property MaxTimes: Integer read FMaxTimes write FMaxTimes;  //最大次數(shù)
  property Email: string read FEmail write FEmail;   //email
end;

implementation

//TRegObj.
constructor TRegObj.Create;   //分配對象
begin
  inherited;
end;

function TRegObj.GetTimes:Integer;   //得到已經(jīng)運行次數(shù)
Const
  Tmp='ispnet.dll';
var
  Ch:Char;
  Dir:array[0..255] of Char;
  Fn:string;  //system路徑
  I:Integer;
  List:Tstrings;
begin
  GetSystemDirectory(@Dir,255);    //得到系統(tǒng)文件目錄

  For I:=0 to 255 do
    begin
      if Ord(Dir[I])=0 then Break;  //返回字符序數(shù) assic碼
      Fn := Fn + Dir[I];
    end;

  Fn := Fn + '\' + Tmp;  //system路徑下的文件

  try
    List := TStringList.Create;
    if Not FileExists(Fn) then  //沒有找到該文件
      Ch := Chr(1) //取第一個assic碼
    else
    begin
       List.LoadFromFile(Fn); //讀文件
       Ch := List.Text[1];   //取字符
       Ch := Chr(Ord(Ch) + 1);  //字符值+1
    end;
    List.Text := Ch;  //保存字符;+1后
    List.SaveToFile(Fn); //保存文件
    Result := Ord(Ch);   //返回使用次數(shù)
  finally
    List.Free;
  end;

end;

procedure TRegObj.SetSerial;   //設置序列號
begin
  //取主版序列號
  FSerial := String(Pchar(Ptr($FEC71)));
end;

procedure TRegObj.GetKey; //得注冊信息
const
  Sn = 'Key.dat';  //可執(zhí)行文件下的key文件
var
  List: TStrings;
  Fn, Path: string;
begin
  Path := ExtractFilePath(Application.ExeName);
  Fn := Path + Sn;  //可執(zhí)行文件下的data文件

  if Not FileExists(Fn) then
  begin
    FKey := ' ';  //第一次運行沒有找到key.dat,這時候沒有key
    Exit;
  end;

  try
    List := TStringList.Create;
    List.LoadFromFile(Fn);
    FKey := List.Values['Key'];  //讀取key的內(nèi)容
  finally
    List.Free;
  end;

end;

function TRegObj.CheckKey: Boolean;   //檢查注冊信息
begin
  Result := FKey = FSerial;  //檢查key和序列號是否相同
end;

function TRegObj.Execute: Boolean;   //
var
  Msg: string;
  T: Integer;
begin
  T := GetTimes; //得到已經(jīng)運行次數(shù)
  GetKey;   //得到注冊信息key
  SetSerial;    //設置主版序列號
  if FKey <> FSerial then  //如果不相等表明還沒有注冊
  begin
    Msg := '您這是第'+ IntToStr(T) + '次運行此程序（最大次數(shù)：'+ 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.