regobj.pas

培训管理系统

unit RegObj;

interface

uses
Windows,Messages,SysUtils,Classes,Forms;

type
  TRegObj=class
private
  FSerial:string;  //序列号
  FKey:string;     //注册key
  FMaxTimes:Integer;  //最大使用次数
  FCompany:string;  //公司名称
  FEmail:string;   //email

protected
  procedure SetSerial;  //设置序列号

  procedure GetKey;  //得到注册key
  function GetTimes:Integer;  //得到使用次数
  function CheckKey:Boolean;  //检查序列号和key是否相同
public
  constructor Create;  //分配对象
  function Execute:Boolean;   //执行
published        //write file
  property Company:string read FCompany write FCompany;    //公司名
  property MaxTimes: Integer read FMaxTimes write FMaxTimes;  //最大次数
  property Email: string read FEmail write FEmail;   //email
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;  //system路径
  I:Integer;
  List:Tstrings;
begin
  GetSystemDirectory(@Dir,255);    //得到系统文件目录

  For I:=0 to 255 do
    begin
      if Ord(Dir[I])=0 then Break;  //返回字符序数 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);   //返回使用次数
  finally
    List.Free;
  end;

end;

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

procedure TRegObj.GetKey; //得注册信息
const
  Sn = 'Key.dat';  //可执行文件下的key文件
var
  List: TStrings;
  Fn, Path: string;
begin
  Path := ExtractFilePath(Application.ExeName);
  Fn := Path + Sn;  //可执行文件下的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的内容
  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; //得到已经运行次数
  GetKey;   //得到注册信息key
  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.