抄来的！
单元：
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 255do
begin
if Ord(Dir)=0 then
Break;
//返回字符序数 assic码
Fn := Fn + Dir;
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.
主窗口的oncreate中写
//创建注册信息;
try
Obj := TRegObj.Create;
Obj.MaxTimes := 30;
Obj.Company :='XX软件公司';
Obj.Email :='biz@163.com';
Obj.Execute;
finally
Obj.Free;
end;
