registerta.pas

RegistTimes RegistDays时间限制控制控件。(有源代码）工作在：D2 D3 D4 D5。作者：Mats Asplund。

unit RegisterTa;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry;

type
  TRegister = class(TComponent)
  private
    { D閏larations priv閑s }
    FPassWord:string;
    FTexte:string;
    FNomProg:string;
    FRegistered:boolean;
    FNbreJours:integer;
    FMess:string;
    FParvenir:string;
    function GetTexteCode:string;
    function GetTexteDecode:string;

  protected
    { D閏larations prot間閑s }
  public
    { D閏larations publiques }
    procedure TestRegistered;
    property Registered:boolean read FRegistered;

  published
    { D閏larations publi閑s }
    property PassWord:string read FPassWord write FPassWord;
    property NomProg:string read FNomProg write FNomProg;
    property NbreJours:integer read FNbreJours write FNbreJours;
    property RegisterMessage:string read FMess write FMess;
    property ParvenirMessage:string read FParvenir write FParvenir;

  end;

procedure Register;

implementation

function TRegister.GetTexteCode:string;
var
psw,txt,txtf:array[0..250] of char;
posp,post,lenp,lent:integer;

begin
strpcopy(psw,FPassWord);
strpcopy(txt,FTexte);
lenp:=length(FPassWord);
lent:=length(FTexte);
txtf:='';
posp:=0;
for post:=0 to lent-1 do
    begin
    txtf[post]:=chr(ord(psw[posp])+ord(txt[post]));
    inc(posp);
    if posp=lenp then posp:=0;
    end;
result:=strpas(txtf);
end;


function TRegister.GetTexteDecode:string;
var
psw,txt,txtf:array[0..250] of char;
posp,post,lenp,lent:integer;

begin
strpcopy(psw,FPassWord);
strpcopy(txt,FTexte);
lenp:=length(FPassWord);
lent:=length(FTexte);
txtf:='';
posp:=0;
for post:=0 to lent-1 do
    begin
    txtf[post]:=chr(ord(txt[post])-ord(psw[posp]));
    inc(posp);
    if posp=lenp then posp:=0;
    end;
result:=strpas(txtf);
end;


procedure TRegister.TestRegistered;
var
MyReg:TRegistry;
Code,UserID,Mess,Parvenir:string;
InstDate,UsedDate:TDateTime;
Reponse:word;
DifJours:integer;

begin
if FPassWord='' then
FPassWord:=InputBox('Error', 'Please enter PassWord for encryption', 'PassWord');
if FNomProg='' then
FNomProg:=InputBox('Error', 'Please enter your application name', 'NomProg');
if FParvenir='' then
FParvenir:=InputBox('Error', 'Please enter the address where the user can send you the registration file', 'Parvenire');
MyReg:=TRegistry.create;
MyReg.LazyWrite:=False;
MyReg.RootKey:=HKEY_LOCAL_MACHINE;
MyReg.OpenKey('\software\'+FNomProg+'\LastUsed',true);
if MyReg.ReadString('')='' then
   begin
   FTexte:=DateToStr(Date);
   MyReg.WriteString('',GetTexteCode);
   end;
MyReg.CloseKey;
MyReg.OpenKey('\software\'+FNomProg+'\Code',true);
if (MyReg.ValueExists('')=true) and (MyReg.ReadString('')<>'') then
   begin
   FTexte:=MyReg.ReadString('');
   Code:=GetTexteDecode;
   MyReg.CloseKey;
   MyReg.OpenKey('\software\microsoft\windows\currentversion',false);
   UserID:=MyReg.ReadString('RegisteredOwner');
   if UserID<>Code then
      begin
      MessageDlg('Registration code error.',mtwarning,[mbok],0);
      application.terminate;
      end;
   FRegistered:=True;
   end
else
   begin
   MyReg.CloseKey;
   MyReg.OpenKey('\software\'+FNomProg+'\InstDate',true);
   if (MyReg.ValueExists('')=true) and (MyReg.ReadString('')<>'') then
      begin
      FTexte:=MyReg.ReadString('');
      InstDate:=StrToDate(GetTexteDecode);
      DifJours:=round(abs(Date-InstDate));
      MyReg.CloseKey;
      MyReg.OpenKey('\software\'+FNomProg+'\LastUsed',true);
      FTexte:=MyReg.ReadString('');
      UsedDate:=StrToDate(GetTexteDecode);
      if UsedDate>Date then
         begin
         MessageDlg('Erreur !'+#10#13+'The computer date has been changed !!',mtWarning,[mbOK],0);
         application.terminate;
         end;
      if DifJours>FNbreJours then
          begin
          mess:='Your trial time is finished.'+#13#10+'Please register.';
          if FMess<>'' then Mess:=Mess+#13#10+FMess;
          Mess:=Mess+#13#10+'Would you like to register ?';
          reponse:=messagedlg(Mess,mtinformation,[mbyes,mbno],0);
          if reponse=mryes then
             begin
             MyReg.CloseKey;
             MyReg.OpenKey('\software\microsoft\windows\currentversion',false);
             UserID:=MyReg.ReadString('RegisteredOwner');
             writeprivateprofilestring('Info','Prog',pchar(FNomProg),pchar(extractfilepath(application.exename)+'Register.dat'));
             writeprivateprofilestring('Info','User',pchar(userid),pchar(extractfilepath(application.exename)+'Register.dat'));
             parvenir:='The "register.dat" file which contain the informations needed for your registration has been created in its directory.'+#13#10+FParvenir;
             messagedlg(Parvenir,mtinformation,[mbok],0);
             application.terminate;
             end
          else
              application.terminate;
          end
      else
          begin
          mess:='Trial time : '+inttostr(FNbreJours-DifJours)+' days remaining before the registration.'+#13#10+'You should register now.';
          if FMess<>'' then Mess:=Mess+#13#10+FMess;
          Mess:=Mess+#13#10+'Souhaitez vous vous enregistrer ?';
          reponse:=messagedlg(Mess,mtinformation,[mbyes,mbno],0);
          if reponse=mryes then
             begin
             MyReg.CloseKey;
             MyReg.OpenKey('\software\microsoft\windows\currentversion',false);
             UserID:=MyReg.ReadString('RegisteredOwner');
             writeprivateprofilestring('Info','Prog',pchar(FNomProg),pchar(extractfilepath(application.exename)+'Register.dat'));
             writeprivateprofilestring('Info','User',pchar(userid),pchar(extractfilepath(application.exename)+'Register.dat'));
             parvenir:='Le fichier "register.dat" contenant les informations n閏essaires